Bitmap in Thread laden

[Gruber_Hans_12345]

Gibt es irgendwas zu beachten, wenn ich ein TBitmap in einem Thread lade?

Habe eine funktionierende procedure, die wenn ich sie in einen Thread auslagere, nur mehr ein schwarzes TBitmap liefert ... Threadsafe ist alles

[Muetze1]

Zitat:

Zitat von Gruber_Hans_12345

Threadsafe ist alles

Nope, TCanvas, TBitmap, TBrush, TPen, etc sind es nicht...

[busybyte]

Code?

[Gruber_Hans_12345]

hmmmm, dann baue ich mal um, das ich im thread nur mehr per Windows API arbeite, dann sollte es mit dem Thread ja keine probs mehr geben.
den da einzige was der thread macht ist ein jpeg laden, dieses in ein bitmap wandeln und dann stretchen -> das wars

[Gruber_Hans_12345]

wobei, reicht nicht ein einfaches canvas.lock?

bzw. die zwei threads greifen eh nicht auf den selben canvas zu ...?

[alleinherrscher]

Dein Programm hat aber einen Main VCL Thread für Eingaben und Ausgaben auf deinem Formular. Daher müssen deine Threads in erster Linie mal mit diesem Thread synchronisiert werden.

Du kannst Threads synchronisieren indem du TThread.Synchronize aufrufst und als Argument eine parameterlose Prozedur übergibst, die dann dein Bitmap läd.

edit: Grade mal gegoogelt und einen sehr informativen Text auf englisch gefunden:

Multithreading with Delphi: Basic synchronisation

[Blup]

Zitat:

Zitat von alleinherrscher

Du kannst Threads synchronisieren indem du TThread.Synchronize aufrufst und als Argument eine parameterlose Prozedur übergibst, die dann dein Bitmap läd.

Dann wäre aber der eigene Thread zum Laden der Grafik sinnlos, da die Arbeit doch wieder im Mainthread erfolgt.

[alleinherrscher]

Zitat:

Zitat von Blup

Zitat:

Zitat von alleinherrscher

Du kannst Threads synchronisieren indem du TThread.Synchronize aufrufst und als Argument eine parameterlose Prozedur übergibst, die dann dein Bitmap läd.

Dann wäre aber der eigene Thread zum Laden der Grafik sinnlos, da die Arbeit doch wieder im Mainthread erfolgt.

Dann muss er halt das Bitmap im Thread laden und anschließend per CopyFrom oder per Bitblt synchronisiert auf die Oberfläche bringen... müsste doch gehen oder? Ich überleg grad nur, ob sich dann die Katze wieder in den Schwanz beißt...

[Gruber_Hans_12345]

Hmmm, ich weiss was synchronisation ist, und "meine" teile isnd ja durchaus synchron ... nur weiss ich nicht wie ichs mit der VCL machen soll.
Ich kann ja nicht absolut alles synchronisieren, dann bringt mir der thread ja nix?!?!?!?

Thread Code

Delphi-Quellcode:

{$DEFINE USE_THREADLOADING}
procedure TLoadImage.DoLoadImage(FileName : string);
var
    picRect     : TRect;
    pWidth      : integer;
    pHeight     : integer;
    jp          : TJPEGImage;
    pic         : TPicture;
begin
    EnterCriticalSection(fCS);
    try
        if FileName = '' then exit;

        OutputDebugString(PChar('Loading image ' +FileName));
        fInLoad         := TRUE;
        fLoadedImage    := '';

        jp          := TJPEGImage.Create;
        jp.LoadFromFile(FileName);
        pWidth      := jp.Width;
        pHeight     := jp.Height;

        if assigned(fBitmap) then fBitmap.Free;

        fBitmap                         := TBitmap.Create;
        fBitmap.Width                   := 1280;
        fBitmap.Height                  := 1024;
        fBitmap.PixelFormat             := pf32bit;
        fBitmap.Canvas.Brush.Color      := clBlack;
        Windows.FillRect(fBitmap.Canvas.Handle, Rect(0,0,fBitmap.Width, fBitmap.Height), fBitmap.Canvas.Brush.Handle);

        if (pWidth / pHeight) > (1280 / 1024) then begin
            picRect            := Rect(0, (1024 - round((1280 / pWidth) * pHeight)) div 2, 1280, 0);
            picRect.Bottom     := fBitmap.Height - picRect.Top;
        end
        else begin
            picRect            := Rect(1280 - (round((1024 / pHeight) * pWidth)) div 2, 0, 0, 1024);
            picRect.Right      := fBitmap.Width - picRect.Left;
        end;

        fBitmap.Canvas.StretchDraw(picRect, jp);

        fLoadedImage    := FileName;
        fInLoad         := FALSE;
        fFileName       := '';

        OutputDebugString(PChar('Finish Loading image ' +fLoadedImage));
    finally
        jp.Free;
        LeaveCriticalSection(fCS);
    end;
end;

Code im main, der auf den Thread zugreift (der restliche code arbeitet mit dem Picshow Element)

Delphi-Quellcode:

procedure TMainForm.LoadNextImage;
begin
{$IFDEF USE_THREADLOADING}
        if not TryEnterCriticalSection(imgLoader.fCS) then begin
            OutputDebugString('Bild noch nicht vollständig geladen Recheck in 100ms');
            trCheckLoadImage.Interval   := 100;
            trCheckLoadImage.Enabled    := TRUE;
            exit;
        end;
        try
            if imgLoader.LoadedImage = '' then begin
                OutputDebugString('No image loaded Recheck in 1000ms');
                trCheckLoadImage.Interval   := 1000;
                trCheckLoadImage.Enabled    := TRUE;
                imgLoader.LoadImage(PicturesPath + '\' + GetNextImageName(LoadedImage));
                exit;
            end;

            LoadedImage := ExtractFileName(imgLoader.LoadedImage);
            OutputDebugString(PChar('Image loaded : Using image : '+LoadedImage));
{$ELSE}
            imgLoader.DoLoadImage(PicturesPath + '\' + GetNextImageName(LoadedImage));
{$ENDIF}
            Picshow.Picture.Bitmap.Width        := imgLoader.Bitmap.Width;
            Picshow.Picture.Bitmap.Height       := imgLoader.Bitmap.Height;
            Picshow.Picture.Bitmap.PixelFormat  := imgLoader.Bitmap.PixelFormat;
            BitBlt(PicShow.Picture.Bitmap.Canvas.Handle, 0, 0, Picshow.Picture.Bitmap.Width, Picshow.Picture.Bitmap.Height
                    , imgLoader.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);

{$IFDEF USE_THREADLOADING}
            imgLoader.LoadImage(PicturesPath + '\' + GetNextImageName(LoadedImage));
        finally
            LeaveCriticalSection(imgLoader.fCS);

            trCheckLoadImage.Interval   := 2000;
            trCheckLoadImage.Enabled    := TRUE;
        end;
{$ENDIF}
end;

[Gruber_Hans_12345]

Also ich habe das Gefühl, es hat mit irgendwas anderes zu tun hier ...

habe im hautpthread jetzt ein lock eingebaut, das gewartet wird, bis das bild da ist ...

Delphi-Quellcode:

        finally
            LeaveCriticalSection(imgLoader.fCS);

            // Hauptthread blockieren, bis image geladen ist 
            sleep(100);
            EnterCriticalSection(imgLoader.fCS);
            LeaveCriticalSection(imgLoader.fCS);

            trCheckLoadImage.Interval   := 2000;
            trCheckLoadImage.Enabled    := TRUE;
        end;

und es funktioniert auch nicht?

[sirius]

Das Problem wird mützes kuerzes Statement sein. TPen und TBrush und damit TCanvas benutzen globale Variablen. Die gehen IMHO nicht einzeln zu synchronisieren.

[Gruber_Hans_12345]

Zitat:

Zitat von sirius

Das Problem wird mützes kuerzes Statement sein. TPen und TBrush und damit TCanvas benutzen globale Variablen. Die gehen IMHO nicht einzeln zu synchronisieren.

Aber auch wenn ich zur gänze den MainThread blockiere während der Thread arbeitet, dann funkt es trotzdem nicht
1.) im hauptthread rufe ich EntercriticalSection auf
2.) im hauptthread setze ich ne variable, das der thread was amchen soll
3.) Hauptthread ruft LeaveCS auf
4.) Hauptthread wartet etwas
5.) Thread ruft EnterCS auf
6.) Thread macht sein ding
7.) Hauptthread ruft auch EnterCS auf (wartet also bis der hread fertig ist)
8.) wenn thread fertig ist, dann ruft er LeaveCS auf
9.) Hauptthread ruft auch LEaveCS auf, war ja nur zum warten
10.) Hauptthread macht weiter mit seinen Sachen

[Gruber_Hans_12345]

... ok, dann frag ich mal anders, hat wer einen code, oder gibt es einen code, den man in einen thread auslagern kann, der ein jpeg lädt und dieses resized?

Also irgendwie funktioniert gar nix, ich kann in einem thread nicht einmal ein bitmap erzeugen und einfärben ... ?!?!?!

Warum funktioniert soetwas nicht in einem thread?

Delphi-Quellcode:

procedure TLoadImage.DoLoadImage(FileName : string);
var
    LogBrush    : TLogBrush;
    bHandle     : THandle;
    MemDC       : THandle;
begin
    EnterCriticalSection(fCS);
    try

        MemDC       := CreateCompatibleDC(0);
        fHBitmap    := CreateCompatibleBitmap(MemDC, 1280, 1024);
        SelectObject(MemDC, fHBitmap); 

        LogBrush.lbColor    := ColorToRGB(clRed);
        LogBrush.lbStyle    := BS_SOLID;
        bHandle     := CreateBrushIndirect(LogBrush);

        Windows.FillRect(MemDC, Rect(0, 0, 1280, 1024), bHandle);

        DeleteObject(bHandle);
        DeleteObject(memDC);
    finally
        LeaveCriticalSection(fCS);
    end;
end;

[busybyte]

Ich hab das vor einiger Zeit mal ohne thread gelöst.
Ich hab festgestellt das nicht das Laden, sondern die Anzeige der Bilder so lange dauert.

Den Testcode hab ich wieder gefunden, der ist aber nicht perfekt.
Wenn Du die 6 Labels wieder aktivierst siehst du den Unterschied.

Mit Button 1 wählst Du eine Bild Datei, dann wird der gesamte Ordner + Unterordner nach Dateien abgesucht.
Gleich darauf kannst du Button2 drücken, der die Anzeige der gefundenen Bilder startet.
Der Speed ist nicht schlecht,ich lass immmer mein gesamtes Laufwerk C:\ dursuchen.


Vieleicht kannst du ja was davon gebrauchen.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ExtCtrls,JPEG,ClipBrd;

type

  PSkinDateien=^TStringList;


  TForm1 = class(TForm)
//Die werden benötigt !!!! 
{   OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
 }
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   Procedure Streamini;
   Procedure Streamfree;
   { Private declarations }
  public
  SkinDateien:TStringList;
  SkinDateienP:PSkinDateien;
  SkinListe: TList;
  ErrorCode:integer;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
  procedure resetDatas(Var DList_:TStringList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Var
AnzSkinDateien:Longint;
Search :Boolean;
SkinPfad:String;
Extensions:TStringList;
Imgcnt:integer;
SizeofAll:int64;
StrtTick,Tick:Cardinal;
Abort:Boolean;

const
   FileFilter = '*.bmp;*.jpg;*.jpeg;*.png;|'+
     '*.bmp;*.jpg;*.jpeg;';


procedure TForm1.LoadMemory;
begin
  try
  Search := True;
  AnzSkinDateien:=0;

  if (SkinDateien=nil) then
  SkinDateien:=TStringlist.Create;
  SkinDateien.Clear;
  FindFiles(SkinDateien);
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
//  Memo1.Lines.Assign(SkinDateien);                                          //<---Bremse !!!
  except SkinDateien.Free; end;
end;



function MyGetFileSize(const FileName: String):int64;
var FileHandle: Cardinal; var Data: WIN32_FIND_DATA;
begin
  FileHandle := FindFirstFile(PChar(FileName), Data);
  try
    if FileHandle > 0 then
    begin
    Int64Rec(Result).Hi := Data.nFileSizeHigh;
    Int64Rec(Result).Lo := Data.nFileSizeLow;
    end;
  finally Windows.FindClose(FileHandle);
  end;
end;

procedure TForm1.FindFiles(Var DList_:TStringList);
Var
S:String;
FS:int64;
  procedure DoSearch(const Path:String);
  var SR : TSearchRec;
  begin

    If Findfirst(Path + '*.*',faAnyFile,SR) = 0 then
     try
       repeat

   while Abort do
    exit;

         if GetTickCount >= Tick then
         begin
           Tick:= GetTickCount +100;
           Application.ProcessMessages;
         end;

         If (SR.Attr and faDirectory <> 0)
            and (SR.Name <> '.')
            and (SR.Name <> '..')
            and (SR.Name <> '')
            then
           DoSearch(Path + SR.Name + '\')

         else
          if Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then  //Bug: nur jpeg-Dateien gefixt
             begin
             S:=Path + SR.Name;
             FS:=MyGetFileSize(S);
             //Provisorisch Speicherüberlauf verhindern
             while (SizeofAll+FS>200000000) do
               begin
               ErrorCode:=1;
               exit;
               end;
             SizeofAll:=SizeofAll+FS;
             //In Liste aufnehmen
             SkinDateienP^.Add(S);
             //DList_.Add(S);
             end;

        until FindNext(SR) <> 0;

     finally
       FindClose(SR);
     end;
    end;

begin
    try
     Tick := GetTickCount + 100;
     DOSearch(SkinPfad);
    except DList_.Free;
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
Var Filename_:String;
cnt1,L1:integer;
begin with Opendialog1 do
begin
Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:=  extractfilepath(Filename_);
//    Label1.Caption:='';
    SizeofAll:=0;
    StrtTick:=Gettickcount;
    Abort:=False;
    LoadMemory;    //Dateien suchen und in Stringliste laden
//    Label1.Caption:=inttostr(SkinDateien.Count)+ ' Dateinamen';
//    Label2.Caption:=inttostr(SizeofAll div 1000000)+' MB' ;
//    Label3.Caption:='in ' +inttostr((Gettickcount-StrtTick) div 1000 )+' Sek.' ;
    end;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
Var L1,cnt1_:integer;
  cnt1: Integer;
  FN_:String;
begin
L1:=SkinDateienP^.Count;
StrtTick:=Gettickcount;
imgCnt:=0;
for cnt1 := 0 to L1- 1 do
begin
//Antifreeze;
  if GetTickCount >= Tick then
     begin
     Tick:= GetTickCount +10; //hier kann man rumspielen,wenn's einem zu langsam, oder zu schnell geht
     //MEGABREMSE
     Application.ProcessMessages;
     end;

   while Abort do
    exit;

   try
   if Fileexists(SkinDateien[cnt1]) then
    Image1.Picture.LoadFromFile(SkinDateien[cnt1]);
   inc(imgCnt);                                          //Update V1.31
   except;end;
end;

//Label4.Caption:= inttostr(imgcnt)+' Bilder';
showmessage('Erfolgreich: '+inttostr(imgcnt)+' Bilder');
//Label5.Caption:='in ' +inttostr((Gettickcount-StrtTick) div 1000 )+' Sek.' ;
end;


procedure TForm1.resetDatas(Var DList_:TStringList);
begin
DList_.Clear;
//Memo1.Clear;
end;

Procedure TForm1.Streamini;
begin
Image1.Stretch:=True;
//SkinPfad:='C:\Windows\';
Extensions:=TStringList.Create;
  with Extensions do
    try
    Add('.bmp');
    Add('.jpg');
    Add('.jpeg');
//    Add('.png');
    except   Extensions.Free; end;

{    with Memo1 do
    begin
    Clear;
    Align:=alRight;
    ScrollBars:=ssBoth;
    end;
}
  //Pointer
  GetMem(SkinDateienP, SizeOf(TStringlist));
  SkinDateienP^ := TStringList.Create;
  SkinDateien:=TStringList.Create;
  SkinDateienP^:=SkinDateien;
  SkinListe:=TList.Create;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ErrorCode:=0;
Streamini;
end;

Procedure TForm1.Streamfree;
begin
  SkinDateien.Free;
  freeandnil(Extensions);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Streamfree;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Abort:=True;
Canclose:=True;
end;

end.

Noch schöner gehts natürlich mit ner Miniaturansicht,
die ist aber nicht leicht zu verstehen/bzw. es hagelt erstmal Fehlermeldungen ohne Ende.

[Gruber_Hans_12345]

Also, bei mir dauert das laden ca 700ms.

und da um unteren rand eine Laufschrift läuft, sieht dies sehr blöd aus, wenn diese für 700ms stoppt.
Das laden selbst dauert natürlich nicht 700ms, sondern das laden des JPG, das konvertieren in ein bitmap, und das resizen

[busybyte]

Hm ja hab's gemerkt,sorry ist nicht das Passende.
Dann geht's wohl doch nur ähnlich wie bei der Miniaturansicht.

[Gruber_Hans_12345]

Zitat:

Zitat von busybyte

Hm ja hab's gemerkt,sorry ist nicht das Passende.
Dann geht's wohl doch nur ähnlich wie bei der Miniaturansicht.

was meinst du mit miniaturansicht?

[busybyte]

die IExtractImageDemo.zip anschauen,
und da die Listview-Demo! //EDIT

Es sollte eigentlich die gleiche Qualität und Grösse möglich sein.
Ein bischen mit stretchblt und der Grösse in der Imagelist experimentieren dann müsste das klappen.

Ja funktioniert auch mit 800x600 usw.

[bernhard_LA]

gab es eine Lösung zu diesem Thema ?

[Bummi]

Vielleicht hilft Dir das irgendwie weiter ...