![]() |
Re: Bitmap in Thread laden
Das Problem wird mützes kuerzes Statement sein. TPen und TBrush und damit TCanvas benutzen globale Variablen. Die gehen IMHO nicht einzeln zu synchronisieren.
|
Re: Bitmap in Thread laden
Zitat:
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 |
Re: Bitmap in Thread laden
... 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; |
Re: Bitmap in Thread laden
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:
Noch schöner gehts natürlich mit ner Miniaturansicht,
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. die ist aber nicht leicht zu verstehen/bzw. es hagelt erstmal Fehlermeldungen ohne Ende. |
Re: Bitmap in Thread laden
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 |
Re: Bitmap in Thread laden
Hm ja hab's gemerkt,sorry ist nicht das Passende.
Dann geht's wohl doch nur ähnlich wie bei der Miniaturansicht. |
Re: Bitmap in Thread laden
Zitat:
|
Re: Bitmap in Thread laden
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. |
AW: Bitmap in Thread laden
gab es eine Lösung zu diesem Thema ?
|
AW: Bitmap in Thread laden
Liste der Anhänge anzeigen (Anzahl: 1)
Vielleicht hilft Dir das irgendwie weiter ...
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:47 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz