Bitmap in Thread laden

[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 ...