AW: Threads und TBitmaps
Threads funktionieren, auch in Delphi 7, tadellos. Man muss sie nur zu nehmen wissen ;)
Zitat:
Zitat:
Zitat:
Delphi-Quellcode:
Das betrifft auch Größenänderungen und einfach ALLES was am Bild etwas verändern könnte. Ich persönlich würde diese Dinge sogar noch zusätzlich über eine TCriticalSection absichern. (CriticalSections sind praktisch das gleiche wie Locks, die aber nicht nur ein Bitmap schützen, sondern einen ganzen Block beliebigen Code.)
Bitmap.Canvas.Lock;
try Bitmap.Canvas.Rectangle(blablafoofoo); finally Bitmap.Canvas.Unlock; end; Das gesamte Thema CriticalSections ist bei der Arbeit mit Threads essenziell. Man muss fein säuberlich ALLE Zugriffe auf von mehreren Threads (das eigentliche Programm ist ja auch ein Thread) benutzten Ressourcen gegeneinander verriegeln, sonst hat man - wie du ja merkst - eine AV-Fabrik. Auch sollte man sich angewöhnen NIEMALS aus einem Thread direkt Komponenten auf einem Formular zu benutzen. Das geht fast immer schief, es fällt nur manchmal lange nicht auf, da es gehen kann. Wann immer ein Thread eine Änderung an Formularen auslösen soll, ist der (imho) beste Weg den Formularen mittels eigener Messages und PostMessage() die Änderungen mitzuteilen, und die eigentliche Versorgung der Controls passiert komplett im Kontext des VCL-Threads (=Hauptprogramm). Alles andere wird über kurz oder lang zu einer Synchronisations-Hölle. Noch ein Tipp zu Exceptions in Threads: Normalerweise wird man auf Exceptions im Hauptprogramm durch ein entsprechendes Fester hingewiesen (wenn man sie nicht manuell anderweitig behandelt). Dafür ist der Standard-Exceptionshandler von Delphi (bzw. der VCL) zuständig, und der greift bei Threads nicht. Wenn in einem Thread eine Exception passiert, schießt Windows den Thread einfach weg. Um dies zu verhindern, und um dennoch zu sehen WAS da schief gelaufen ist, baue ich ganz gerne etwas dieser Art:
Delphi-Quellcode:
Damit laufen in meinem Memo immer brav die ganzen Exceptions im Thread ein, und da die Exceptions im Thread dann behandelt werden, knallt Windows diesen auch nicht sofort weg.
type
TThreadException = record Message: String; end; PThreadException = ^TThreadException; const WM_THREAD_EXCEPTION = WM_USER + (irgendeinezahl); implementation procedure TMyThread.Execute; var ex: PThreadException; begin try // Mein Thread-Code except on e: Exception do begin New(ex); ex^.Message := e.Message; PostMessage(WM_THREAD_EXCEPTION, MainFormHandle, Integer(ex), 0); end; end; end; // Mainform type TMainForm = class(TForm) procedure ThreadExceptionHandler(var msg: TMessage); message WM_THREAD_EXCEPTION: ... end; implementation TMainForm.ThreadExceptionHandler(var msg: TMessage); var ex: PThreadException; begin ex := PThreadException(msg.LParam); Memo1.Lines.Add(ex^.Message); Dispose(ex); end; Fazit: Man kann in Threads nicht mit dem warmen weichen Komfort, den man von der VCL gewöht ist so unbedarft arbeiten. Man muss deutlich mehr aufpassen, und einige Dinge zu Fuß erledigen. Die Threads an und für sich funktionieren einwandfrei. Ich gebe aber zu, dass es etwas Eingewöhnungszeit und ein etwas anderes Denken braucht. |
AW: Threads und TBitmaps
Ich habe jetzt herausgefunden, dass es zu Fehlern kommt, da im Schritt-für-Schritt Modus nur der Thread angehalten wird.
Die Hauptunit greifft nach wie vor im hohen Intervall auf ein Bild zu, um es zu malen, wodurch es bei Größenänderungen zu Fehlermeldungen kommt. Jetzt muss ich nurnoch herausfinden, wieso das geschieht, obwohl die Bitmap deren Größe geändert wird nicht dieselbe ist wie die, die gemalt wird :? Der Code hier scheint den EOutofresource-Fehler aka "Bitmap wird bereits benutzt" zu umgehen. Vermutlich kann man das auch durch Synchronisierung vermeiden.
Delphi-Quellcode:
Procedure TForm1.ZeichneBild;
begin image1.Canvas.Draw(0,0,PaintThread.Getbild); PaintThread.SetExport; end; procedure TPaintThread.Execute; begin while (Terminated = False) do begin if (Paint = True) then //Soll gezeichnet werden? begin Bearbeitend := True; if (Exportierend = False) then //Wird exportiert? begin MyBild.canvas.unlock; //Nicht sicher ob nötig Mybild.Width := random(5000) + 5000; //Fehlerquelle Mybild.Height := random(5000) + 5000; //Fehlerquelle MyBild.Canvas.Rectangle(0, 0, random(999) + 1, random(999) + 1); Bearbeitend := False; Paint := False; end else begin Bearbeitend := False; While (Exportierend = True) do begin //Bis das Bild fertig exportiert wurde end; end; end else sleep(1); end; end; function TPaintThread.Getbild : TBitmap; begin Exportierend := True; if (Bearbeitend = False) then //Wird Bild bearbeitet? begin MyBild.Canvas.Unlock; //Nicht sicher ob nötig result := MyBild; end else begin Exportierend := False; While (Bearbeitend = True) do begin //Warte, bis die Bearbeitung abgeschlossen ist end; result := Getbild; end; end; procedure TPaintThread.SetExport; begin Exportierend := False; Paint := True; end; |
AW: Threads und TBitmaps
Danke für die hilfreichen Infos, Medium.
Ich hatte bis jetzt die Erfahrung, dass Bitmaps, die vom Thread erstellt und benutzt werden, Fehlermeldungen hervorrufen können, was durch .unlock vor dem Zeichnen im Thread nichtmehr geschah. Von daher sollte die Bitmap entweder nicht standardmässig auf unlocked stehen oder die routine macht noch andere relevante dinge. Jedenfalls werde ich das locken ausprobieren. mfg Groudonx |
AW: Threads und TBitmaps
So wie du da in den Thread reingreifst, ist das wie Schalten ohne Kuppeln.
Manchmal funktioniert es, manchmal knirscht es und manchmal fliegt dir das Getriebe um die Ohren. Generell solltest du hier wohl mit Queues arbeiten.
|
AW: Threads und TBitmaps
Wenn ich nun statt einem rechteck eine bitmap malen will, sollte logischerweise die Malfläche wieder gelockt werden.
Das zu malende Bild muss aber unlocked werden, oder?
Delphi-Quellcode:
Dieser Code führt dazu, dass mir das Programm nach Sekunden permanent einfriert.
MyBild.Canvas.lock;
nochnbild.Canvas.unlock; MyBild.Canvas.Draw(0,0,nochnbild); nochnbild.Canvas.lock; MyBild.Canvas.unlock; Entferne ich jedoch
Delphi-Quellcode:
so läuft es prima.
nochnbild.Canvas.lock;
Meine Frage ist also, ob locken wirklich sinnvoll ist bzw. wieso es in dem Fall diesen extrem negativen Fehler hat, durch den das ganze Programm unbrauchbar wird. |
AW: Threads und TBitmaps
Ich bin mir nicht sicher, aber du bringst da wohl einiges durcheinander?
Zum einen geht nicht hervor wer den nun dein "ZeichneBild" aufruft, über die Synchronize() Routine würde das dann geschehen, wenn es im Thread fertig erstellt ist und du wirst alle deine Probleme los. Daher die grundsätzliche Frage: Willst du das Bild im Thread erstellen weil es so rechenintensiv ist, dann bist du mit Synchronize am besten dran oder kriegst du im Thread Bilder in schneller Folge und willst nur "hin und wieder" (zb.: 25 fps) ein Bild anzeigen aber alle daten speichern, dann solltest du ein Queue verwenden. Wildes Locken/Unlock bringt auch nichts, mit einem Lock der Bitmap sperrst du Zugriffe anderer Threads, also alles Locken zeichnen und wieder Freigeben und natürlich über try-sichern, damit die Bitmap nicht gelockt bleiben.... |
AW: Threads und TBitmaps
Das was du da jetzt tust, sieht ganz danach aus als würdest du überall wo es am Rohr leckt ein Pflaster aufkleben, und hoffen, dass das hält, und das Rohr nicht wieder an anderer Stelle platzt. Du solltest ernsthaft überdenken ein Rohr aus anderem Material zu nehmen. (Das war voll metaphorisch. Was ich sagen will ist: Du hast ein ziemliches Gewurschtel, und wurschtelst es in der Hoffnung, dass irgendwann ein (scheinbar) funktionierendes Knäul stehen bleibt, nur noch mehr.) (Okay, das war auch metaphorisch...)
|
AW: Threads und TBitmaps
Ich möchte Bilder in einem Thread zeichnen lassen und diese dann auf die Form kopieren.
Dabei soll die CPU-Auslastung in den Thread geschoben werden. |
AW: Threads und TBitmaps
Hier mal so ein BitmapThread
Delphi-Quellcode:
und die passende Form dazu
unit BitmapProducerThread;
interface uses System.Generics.Collections, System.Classes, System.SyncObjs, Vcl.Graphics; type TBitmapParameters = record Width : Integer; Height : Integer; constructor Create( AWidth, AHeight : Integer ); end; TBitmapProducerThread = class( TThread ) private FEvent : TEvent; FInputCS : TCriticalSection; FOutputCS : TCriticalSection; FInputQueue : TQueue<TBitmapParameters>; FOutput : TBitmap; FOnOutputChanged : TNotifyEvent; procedure SetOutput( const Value : TBitmap ); procedure SetOnOutputChanged( const Value : TNotifyEvent ); function GetOnOutputChanged : TNotifyEvent; procedure DoOutputChanged; protected procedure Execute; override; procedure TerminatedSet; override; function GetBitmapParameter : TBitmapParameters; procedure DoExecute; public constructor Create; destructor Destroy; override; procedure Add( ABitmapParameters : TBitmapParameters ); procedure Get( ABitmap : TBitmap ); property OnOutputChanged : TNotifyEvent read GetOnOutputChanged write SetOnOutputChanged; end; implementation { TBitmapParameters } constructor TBitmapParameters.Create( AWidth, AHeight : Integer ); begin Width := AWidth; Height := AHeight; end; { TBitmapProducerThread } procedure TBitmapProducerThread.Add( ABitmapParameters : TBitmapParameters ); begin FInputCS.Enter; try FInputQueue.Enqueue( ABitmapParameters ); FEvent.SetEvent; finally FInputCS.Leave; end; end; constructor TBitmapProducerThread.Create; begin FInputCS := TCriticalSection.Create; FOutputCS := TCriticalSection.Create; FEvent := TEvent.Create( nil, True, False, '' ); FInputQueue := TQueue<TBitmapParameters>.Create; FOutput := TBitmap.Create; inherited Create; end; destructor TBitmapProducerThread.Destroy; begin inherited; FInputQueue.Free; FOutput.Free; FOutputCS.Free; FInputCS.Free; FEvent.Free; end; procedure TBitmapProducerThread.DoExecute; var LBitmap : TBitmap; LParams : TBitmapParameters; LIdx : Integer; begin // Parameter aus Queue holen LParams := GetBitmapParameter; LBitmap := TBitmap.Create; try // Bitmap erstellen LBitmap.Canvas.Lock; try LBitmap.Width := LParams.Width; LBitmap.Height := LParams.Height; // 5000 rote Pixel auf ein Bitmap malen for LIdx := 1 to 5000 do LBitmap.Canvas.Pixels[Random( LBitmap.Width ), Random( LBitmap.Height )] := clRed; finally LBitmap.Canvas.Unlock; end; // Bitmap in die Ausgabe schreiben SetOutput( LBitmap ); finally LBitmap.Free; end; // Benachrichtigen Synchronize( DoOutputChanged ); end; procedure TBitmapProducerThread.DoOutputChanged; var LEvent : TNotifyEvent; begin LEvent := OnOutputChanged; if Assigned( LEvent ) then LEvent( Self ); end; procedure TBitmapProducerThread.Execute; begin inherited; while not Terminated do begin FEvent.WaitFor; if not Terminated then begin DoExecute; end; end; end; procedure TBitmapProducerThread.Get( ABitmap : TBitmap ); begin FOutputCS.Enter; try if Assigned( FOutput ) then ABitmap.Assign( FOutput ); finally FOutputCS.Leave; end; end; function TBitmapProducerThread.GetBitmapParameter : TBitmapParameters; begin FInputCS.Enter; try Result := FInputQueue.Dequeue; if ( FInputQueue.Count = 0 ) and not Terminated then FEvent.ResetEvent; finally FInputCS.Leave; end; end; function TBitmapProducerThread.GetOnOutputChanged : TNotifyEvent; begin FOutputCS.Enter; try Result := FOnOutputChanged; finally FOutputCS.Leave; end; end; procedure TBitmapProducerThread.SetOnOutputChanged( const Value : TNotifyEvent ); begin FOutputCS.Enter; try FOnOutputChanged := Value; finally FOutputCS.Leave; end; end; procedure TBitmapProducerThread.SetOutput( const Value : TBitmap ); begin FOutputCS.Enter; try FOutput.Assign( Value ); finally FOutputCS.Leave; end; end; procedure TBitmapProducerThread.TerminatedSet; begin inherited; FEvent.SetEvent; end; end.
Delphi-Quellcode:
die DPR ist recht harmlos
unit FormMain;
interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, BitmapProducerThread, Vcl.StdCtrls; type TForm1 = class( TForm ) Image1 : TImage; Button1 : TButton; ListBox1 : TListBox; procedure Button1Click( Sender : TObject ); private FBitmapProducer : TBitmapProducerThread; procedure BitmapProducerOutputChanged( Sender : TObject ); public procedure AfterConstruction; override; procedure BeforeDestruction; override; end; var Form1 : TForm1; implementation {$R *.dfm} { TForm1 } procedure TForm1.AfterConstruction; begin inherited; FBitmapProducer := TBitmapProducerThread.Create; FBitmapProducer.OnOutputChanged := BitmapProducerOutputChanged; end; procedure TForm1.BeforeDestruction; begin inherited; FBitmapProducer.OnOutputChanged := nil; FBitmapProducer.Free; end; procedure TForm1.BitmapProducerOutputChanged( Sender : TObject ); begin FBitmapProducer.Get( Image1.Picture.Bitmap ); end; procedure TForm1.Button1Click( Sender : TObject ); var LIdx : Integer; begin ListBox1.Clear; for LIdx := 1 to 200 do FBitmapProducer.Add( TBitmapParameters.Create( Image1.Width, Image1.Height ) ); end; end.
Delphi-Quellcode:
program dp_181416;
uses Vcl.Forms, FormMain in 'FormMain.pas' {Form1}, BitmapProducerThread in 'BitmapProducerThread.pas'; {$R *.res} begin ReportMemoryLeaksOnShutdown := True; Randomize; Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TForm1, Form1); Application.Run; end. |
AW: Threads und TBitmaps
Hab mir jetzt mal eine Unit mit Synchronize angeschaut, scheint auf den ersten Blick zu funktionieren.
Den Quelltext von Sir Rufo habe ich versucht zu kompilieren, aber Delphi 7 kennt kein "System.Generics.Collections" (hoffe ist nicht wichtig). Nach der Anpassung der Unit-Bezeichnungen kommt leider schon bei Zeile 14
Delphi-Quellcode:
die nächste Fehlermeldung "End erwartet aber constructor gefunden"
constructor Create( AWidth, AHeight : Integer );
Da ich mich nur mehr oder weniger mit Basics auskenne möchte ich lieber nicht versuchen, die ganzen Stellen umzuschreiben. Trotzdem werde ich mir mal die Synchronize Methode genauer ansehen :wink: |
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:28 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz