Threads und TBitmaps

[TheGroudonx]

Hallo,

ich möchte ein Program so abändern, dass CPU-lastige Grafikfunktionen von einem anderen Kern, also in einem Thread, abgearbeitet werden.
Dabei soll in einem bestimmtem Interval das berechnete Bild(TBitmap) auf die Mainform(TImage) kopiert werden.
Ich habe bis jetzt folgende Ansätze ausprobiert:
1. Das Bild wird von dem Thread auf die Mainform gezeichnet.
2. Die Mainform zeichnet das Bild durch Nachfrage an den Thread selbst.

Das funkioniert kurzzeitig auch relativ gut, nur gibt es eben danach je nach Ansatz EOutofresource-Fehler(1) oder ein leeres Ergebnisbild(2), quasi zu einem zufälligen Zeitpunkt...
Der EOutofresource-Fehler heißt meistens "Falscher Parameter".

Der untere Quelltext ist ein einfaches Beispiel für die Basisfunktionen, die bei meinem Program gebraucht werden.
Er erzeugt nach z.B. 1 Min die Fehlermeldung.



procedure TPaintThread.Execute;
begin

while (Terminated = False) do
begin

if (MyBild = NIL) then
begin

randomize;

MyBild := TBitmap.create;
MyBild.Width := 1000;
MyBild.Height := 1000;
MyBild.Canvas.Brush.Color := clgreen;

end
else
begin

MyBild.Canvas.Rectangle(0, 0, random(500) + 1, random(500) + 1);
Form1.Image1.Picture.Bitmap := MyBild; //Ansatz 1

end;

sleep(1);

end;
end;


Meine Frage ist nun, wie sich Zeichenoperationen auslagern lassen, ohne Fehlermeldungen auszulösen.

[Dejan Vu]

Zunächst einmal darfst Du aus einem Thread heraus nicht auf den Canvas malen, also VCL-Operationen ausführen. Ergo kann dein Thread die Bitmaps nur neu berechnen. Zeichnen muss der Hauptthread

Du könntest einen Timer im Hauptthread starten, der alle 20ms Sekunden die Bitmap neu zeichnet (wenn sie sich verändert hat). Die Threads verändern nun irgendwann, von mir auch aus öfter als alle 20ms, das Bitmap und legen den Schalter 'Bitmap hat sich geändert' um.

Der Hauptthread fragt den Schalter alle 20ms ab und zeichnet dann neu.

Schalter und Bitmap müssen über Resourcenschutzblöcke (einer reicht) (TCriticalSection) gesichert werden.

[bernau]

Die Ressourcen dürften bei dir schwinden, weil du ein Bitmap erzeugst (mit Create) aber am Ende der Procedure nicht frei gibst (Free). Das Bitmap hat mit den Dimensionen eine größe von 3MB. kannst ja ausrechnen, wie oft man ein Bitmap erzeugen kann, bis der Hauptspeicher aufgebraucht ist.

[bernau]

Sehe grade, daß du MyBild auf NIL testest. Mein Post hat sich also erledigt.

[Whookie]

Wenn es nur darum geht nach einem längerem Zeichenprozess das Bild in der MainForm darzustellen könnte man das auch so machen:

Delphi-Quellcode:

constructor TImageRenderer.Create;
begin
  inherited Create;
  fBmp := TBitmap.Create;
  fBmp.SetSize(100, 100);
  fBmp.PixelFormat := pf24Bit;
end;

destructor TImageRenderer.Destroy;
begin
  fBmp.Free;
  inherited;
end;

procedure TImageRenderer.Execute;
var
  ix: Integer;
  iy: Integer;
begin
  while Not Terminated do
  begin
    fBmp.Canvas.Lock;
    for ix := 0 to 99 do
    begin
      for iy := 0 to 99 do
      begin
        fBmp.Canvas.Pixels[ix,iy] := RGB(Random(256),Random(256),Random(256));
      end;
      Sleep(5);
    end;
    fBmp.Canvas.UnLock;
    Synchronize(PaintBmp);
  end;
end;


procedure TImageRenderer.PaintBmp;
begin
  if assigned(fOnPaint) then
  begin
    fOnPaint(fBmp);
  end;
end;

Angehängt ist ein kleines Projekt mit dem das läuft...

[TheGroudonx]

Hallo Whookie,

ich hab mir dein Projekt mal angesehen und es an Delphi 7 angepasst,
starte ich es und drücke den Button so wird jedoch sofort eine Fehlermeldung(s. Anhang) ausgegeben :/

[Whookie]

Ups ... Delphi 7 ... soweit ich weiß hat sich gerade in den Thread-Klassen einiges getan....
was hier das Problem ist, kann ich so leider nicht sagen...

Ich würde dir empfehlen das ganze mal auszubauen und zu sehen wo das Problem liegt:

Delphi-Quellcode:

procedure TImageRenderer.Execute;
var
  ix: Integer;
  iy: Integer;
begin
  while Not Terminated do
  begin
    for ix := 0 to 99 do
    begin
      for iy := 0 to 99 do
      begin
      end;
      Sleep(5);
    end;
    Synchronize(PaintBmp);
  end;
end;

sollte mal laufen (aber erst mal ohne OnPaint zu verbinden)

[TheGroudonx]

Tut mir Leid für die lange Zeitspanne bis zur Antwort,

ich habe mittlerweile herausgefunden, dass der Aufruf aus dem Thread heraus das Problem ist.
Er soll auf der Form das Bild zeichnen, was zu dem Fehler führt.
Wird im Thread jedoch nur die Berechnung der Threadeigenen Bitmap durchgeführt und diese durch die Form per Canvas.draw kopiert, so funktioniert es fehlerfrei. Zwar erzeugt das wiederum Auslastung, welche eigentlich im Thread sein sollte, jedoch scheint es sich nicht vermeiden zu lassen.

Edit: Die Threadeigene Bitmap muss im Canvas unlocked werden, damit das Bild auf der Form nicht einfriert

[Chemiker]

Hallo TheGroudonx,

man sollte auf jeden Fall den Canvas.lock und Canvas.unlock in einem Schutzblock fassen um die Ausgabe wieder freizugeben, die exklusiv für den Thread geblockt worden ist.
Bei der Ausgabe sollte man bedenken, dass die Grafikausgabe vom BS gepuffert wird, dass bedeutet das wenn der Thread vor der Ausgabe schlafen gelegt wird, keine Ausgabe erfolgt. Mit der Function GdiFlush() kann die Ausgabe erzwungen werden.

Bis bald
Chemiker

[TheGroudonx]

Hallo,

ich verzweifle so langsam an dem Thema Threads...
zwar wird ein Bild ausgegeben, aber es gibt so viele mehr oder weniger zufällig auftretende Fehler...

-Zuerst einmal funktioniert das Schritt-für-Schritt kompilieren des Threads nicht wirklich:
Ein normal durchlaufender Thread bricht beim Schritt-für-Schritt durchgehen zufällig nach ung. 20 durchgängen ab und ist nichtmehr startbar, oder er gibt access violation messages wieder, die sonst nicht kämen, obwohl die Elemente existieren müssten.

-Versuche ich eine Bitmap in ihrer Größe zu verändern, so kommt es dadurch zu einer EOutofrecource-Fehlermeldung. Selbst wenn man die Bitmap auf ihre eigene Größe anpasst, also keine Veränderung, geht das komplette Bild verloren - Was passiert denn da im Thread? Erzeugt er etwa jedesmal eine neue Bitmap, wenn man die Größe ändert, und müllt den Speicher mit den alten Kopien voll?

-Letztendlich ist das Unlocken für mich noch relativ unklar...muss eine Bitmap bei jedem Zeichnen/Prozeduraufruf neu unlocked werden? Ein Projekt von mir Brach ab, obwohl nach dem Create alle Bitmaps unlocked wurden. Der Fehler lies sich nach Debuggen beheben, indem der unlockbefehl einer Bitmap nach create DOPPELT, also HINTEREINANDER!!!, geschrieben wurde.

Das ganze Thema Threads scheint durch und durch voller Fehler zu stecken, es macht kaum Spaß sich den Weg aus denselben zu bahnen...
Jedenfalls in meiner Delphi 7 Version.

Wenn ihr Tipps zu den geschilderten Ereignissen habt die etwas Licht ins Dunkle bringen lasst es mich wissen.

[Medium]

Threads funktionieren, auch in Delphi 7, tadellos. Man muss sie nur zu nehmen wissen ;)

Zitat:

-Zuerst einmal funktioniert das Schritt-für-Schritt kompilieren des Threads nicht wirklich:
Ein normal durchlaufender Thread bricht beim Schritt-für-Schritt durchgehen zufällig nach ung. 20 durchgängen ab und ist nichtmehr startbar, oder er gibt access violation messages wieder, die sonst nicht kämen, obwohl die Elemente existieren müssten.

Du meist vermutlich das Durchsteppen beim Debuggen, nicht Kompilieren. Dies geht eigentlich wunderbar, zumindest so lange nur eine Instanz des Threads läuft. (Sonst springt man mit den Breakpoints wild zwischen den Instanzen hin und her.) Wenn dort AVs passieren, dann deswegen, weil du dort etwas verkehrt machst. Dies kann u.U. ohne Debuggen laufen, weil dann der Speicher nicht durch den Debugger beeinflusst wird, und die Timings in deinem Programm anders sind.

Zitat:

-Versuche ich eine Bitmap in ihrer Größe zu verändern, so kommt es dadurch zu einer EOutofrecource-Fehlermeldung. Selbst wenn man die Bitmap auf ihre eigene Größe anpasst, also keine Veränderung, geht das komplette Bild verloren - Was passiert denn da im Thread? Erzeugt er etwa jedesmal eine neue Bitmap, wenn man die Größe ändert, und müllt den Speicher mit den alten Kopien voll?

Ja klar, wie sonst?

Zitat:

-Letztendlich ist das Unlocken für mich noch relativ unklar...muss eine Bitmap bei jedem Zeichnen/Prozeduraufruf neu unlocked werden? Ein Projekt von mir Brach ab, obwohl nach dem Create alle Bitmaps unlocked wurden. Der Fehler lies sich nach Debuggen beheben, indem der unlockbefehl einer Bitmap nach create DOPPELT, also HINTEREINANDER!!!, geschrieben wurde.

Locken und Unlocken sollte so gehen: Sobald irgendwer etwas mit dem Bitmap macht, muss es vorher gelocked werden, und nachher unlocked. Nach dem Erstellen sind Bitmaps von "natur" aus nicht gelocked. JEDER Zugriff auf die Bilddaten des Bitmaps sollte in etwa so aussehen:

Delphi-Quellcode:

Bitmap.Canvas.Lock;
try
  Bitmap.Canvas.Rectangle(blablafoofoo);
finally
  Bitmap.Canvas.Unlock;
end;

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.)
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:

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;

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.

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.

[TheGroudonx]

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;

[TheGroudonx]

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

[Sir Rufo]

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.

• In die Eingangsqueue trägst du die Vorgaben ein (Größe, etc.) die der Thread benötigt um das Bild zu erstellen.
• Der Thread holt sich aus der Queue diese Werte, errechnet das Bild und schiebt das, wenn fertig in die Ausgangsqueue rein.
• Zum Anzeigen holst du einfach die Bilder aus der Ausgangsqueue ab.

Das Befüllen und Auslesen der Queues muss natürlich mit CriticalSections abgesichert werden.

[TheGroudonx]

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:

 MyBild.Canvas.lock;
 nochnbild.Canvas.unlock;
  
 MyBild.Canvas.Draw(0,0,nochnbild);

 nochnbild.Canvas.lock;
 MyBild.Canvas.unlock;

Dieser Code führt dazu, dass mir das Programm nach Sekunden permanent einfriert.
Entferne ich jedoch

Delphi-Quellcode:

 nochnbild.Canvas.lock;

so läuft es prima.
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.

[Whookie]

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

[Medium]

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

[TheGroudonx]

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.

[Sir Rufo]

Hier mal so ein BitmapThread

Delphi-Quellcode:

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.

und die passende Form dazu

Delphi-Quellcode:

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.

die DPR ist recht harmlos

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.

[TheGroudonx]

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:

    constructor Create( AWidth, AHeight : Integer );

die nächste Fehlermeldung "End erwartet aber constructor gefunden"
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:

[Sir Rufo]

Ah, war mir nicht aufgefallen, dass du nur Delphi 7 hast (du könntest das ja in dein Profil eintragen).

Das Prinzip der CriticalSections, Events und Synchronize bleibt aber gleich und kannst du fast 1:1 übernehmen. Wichtig ist einfach, dass alle Zugriffe von aussen entsprechend geschützt erfolgen.

Auch die Bitmap, die im Thread erzeugt wird, ist erst nach der Fertigstellung von aussen abrufbar. Solange kann von aussen nur das zuletzt erzeugte Bitmap abgerufen werden.

Delphi-Quellcode:

System.Generics.Collections

beinhaltet

Delphi-Quellcode:

TQueue<T>

was du anders lösen müsstest, denn Generics sind Delphi 7 nicht bekannt.

[TheGroudonx]

Die neue Art sieht so aus:

Aufruf:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin        
Paintthread := TPaintThread.create(false);
Paintthread.Image := Image1;
end;

Thread:

Delphi-Quellcode:

unit UThread;

interface  

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;
    
type                           
  Image = TImage;
  TPaintThread = class(TThread)



private

    Zeichenflaeche: TImage;
    MyBild : TBitmap;



    procedure zeichnen;

    procedure SetImage(const Value: TImage);

  protected

    procedure Execute; override;

  public

    constructor Create(CreateSuspended: Boolean);

    property Image: TImage read Zeichenflaeche write SetImage;

  end;





implementation 





constructor TPaintThread.Create(CreateSuspended: Boolean);
begin
inherited;

MyBild := TBitmap.create;
MyBild.LoadFromFile('1.bmp');

end;     



procedure TPaintThread.Execute;
begin

 While (Terminated = False) do
 begin

 Synchronize(Zeichnen);
 sleep(1);

 end;
end;



procedure TPaintThread.Zeichnen;
begin
Zeichenflaeche.Canvas.Draw(random(50) + 1,random(50) + 1,MyBild);
end;   



procedure TPaintThread.SetImage(const Value: TImage);
begin
Zeichenflaeche := Value;
end;

end.

Das geht auch sehr gut.
Ist das in etwa so wie es richtig ist oder müssen nach wie vor Schutzoptionen wie TCriticalSection darin verwendet werden?

[Sir Rufo]

Ähm, das eigentliche Zeichnen erledigt du jetzt im Kontext des Hauptthreads

Delphi-Quellcode:

Synchronize( Zeichnen );

Damit hast du rein gar nichts gewonnen ... ja, es funktioniert, aber wozu benötigst du dann einen Thread, wenn du es eh wieder im Hauptthread zeichnen lässt.

[Whookie]

Zitat:

Zitat von Sir Rufo (Beitrag 1270563)

Damit hast du rein gar nichts gewonnen ... ja, es funktioniert, aber wozu benötigst du dann einen Thread, wenn du es eh wieder im Hauptthread zeichnen lässt.

Das bringt nur was wenn vor dem Synchronize eine gaaaaanze menge arbeit passiert ... "zeichnen" bezieht sich hier ja nur auf einen Blit auf den Screen (der ja eigentlich flott sein sollte)

[TheGroudonx]

In der Tat passiert eine ganze Menge arbeit, das geht aus dem Beispiel jetzt nicht wirklich hervor.
Es sind viele Berechnungen und Zeichnungen, die zu einem Bild zusammengefügt werden, welches dann kopiert werden soll.
Da für jedes Bild alles neu berechnet werden muss ist ein thread sinnvoll.
Soweit ich das sehe wird nur der Synchronize-Teil von der Hauptform ausgeführt während die Berechnung des Bildes, welches später auf die Hauptform gemalt, threadsicher ist?
Oder muss beim Veränderungsvorgang wieder abgesichert werden, obwohl keine Zugriffe von der Hauptform erfolgen (was nicht sehr logisch wäre)?

[Sir Rufo]

Zitat:

Zitat von Whookie (Beitrag 1270564)

Zitat:

Zitat von Sir Rufo (Beitrag 1270563)

Damit hast du rein gar nichts gewonnen ... ja, es funktioniert, aber wozu benötigst du dann einen Thread, wenn du es eh wieder im Hauptthread zeichnen lässt.

Das bringt nur was wenn vor dem Synchronize eine gaaaaanze menge arbeit passiert ... "zeichnen" bezieht sich hier ja nur auf einen Blit auf den Screen (der ja eigentlich flott sein sollte)

Aber wie soll das passieren, er übergibt dem Thread die Referenz auf die Komponente, und dazu müsste man vorher per Synchronize das Bitmap daraus holen, dann verarbeiten und dann zurückschreiben. Und immer hoffen, dass die Komponente noch da ist.

So sollte Multithreading eben gerade nicht funktionieren. Der Backgroundthread bekommt alle Informationen zum Abarbeiten als Kopie übergeben, bearbeitet das und benachrichtigt, dass er damit fertig ist. Dann kann wer auch immer sich dieses abholen.

[Sir Rufo]

Zitat:

Zitat von TheGroudonx (Beitrag 1270565)

In der Tat passiert eine ganze Menge arbeit, das geht aus dem Beispiel jetzt nicht wirklich hervor.
Es sind viele Berechnungen und Zeichnungen, die zu einem Bild zusammengefügt werden, welches dann kopiert werden soll.
Da für jedes Bild alles neu berechnet werden muss ist ein thread sinnvoll.
Soweit ich das sehe wird nur der Synchronize-Teil von der Hauptform ausgeführt während die Berechnung des Bildes, welches später auf die Hauptform gemalt, threadsicher ist?
Oder muss beim Veränderungsvorgang wieder abgesichert werden, obwohl keine Zugriffe von der Hauptform erfolgen (was nicht sehr logisch wäre)?

Beim Multithreading spricht man von Threadkontext und nicht "von der Hauptform ausgeführt". Entweder es wird im MainThreadContext ausgeführt (du kannst gefahrlos auf als Form-Komponenten zugreifen) oder eben nicht. Wenn du nicht im MainThreadContext bist, kannst du per Synchronize eine Methode im MainThreadContext ausführen lassen.

[TheGroudonx]

Zitat:

So sollte Multithreading eben gerade nicht funktionieren. Der Backgroundthread bekommt alle Informationen zum Abarbeiten als Kopie übergeben, bearbeitet das und benachrichtigt, dass er damit fertig ist. Dann kann wer auch immer sich dieses abholen.

Das war ja auch meine Anfangsidee. Leider funktionierte das "abholen" nicht.

[Whookie]

Zitat:

Zitat von Sir Rufo (Beitrag 1270566)

Der Backgroundthread bekommt alle Informationen zum Abarbeiten als Kopie übergeben, bearbeitet das und benachrichtigt, dass er damit fertig ist. Dann kann wer auch immer sich dieses abholen.

Kommt immer auf den Anwendungsfall an, ich verstehe das Beispiel so, dass in:

Delphi-Quellcode:

procedure TPaintThread.Execute;
begin

 While (Terminated = False) do
 begin
   CalcABitmap(MyBild);   // komplexe zeichenoperation...
 Synchronize(Zeichnen);
 sleep(1);

 end;
end;

..auf eine thread-interne ressource gezeichnet wird, CalcABitmap() benötigt entspr. Zeit und - wenn fertig - wird zum mainthread context gewechselt ... und da kann das bild ja abholen wer will ... in dem beispiel wirds halt in ein TImage geblittet und somit am schirm ausgegeben ...

[TheGroudonx]

Was mich nur noch verwundert ist, dass wenn ich den Thread durchsteppe, nach wie vor access-violations bzw auch einmal eine eexternalexception auftreten, während Threadeigene Bitmaps bearbeitet werden, auf die nicht von ausserhalb des Threads zugegriffen wird, welche auch 100% existieren. Dabei variiert das Tempo, in dem man zur nächsten Codezeile springen kann, stark, was normalerweise nicht passiert.

[Whookie]

Lockst du deinen MyBild.Canvas auch korrekt?

Delphi-Quellcode:

procedure TPaintThread.CalcABitmap(const MyBild: TBitmap);
begin
   MyBild.Lock;
   try
     .. malen bis der bär kommt ..
   finally
     MyBild.Unlock;
  end;
end;

[TheGroudonx]

Wie gesagt wenn ich diese Art von locken verwende (MyBild.Canvas.lock) kommt es zu Fehlermeldungen.
Lasse ich es weg funktioniert es in der Regel.
Mein Problem ist jedoch, dass es bei meinem Beispielprojekt funktioniert, nicht aber bei meinem größeren Projekt.
Ich versuce gerade herauszufinden, wo der Unterschied liegt. :?

[TheGroudonx]

Na toll,

habe gerad herausgefunden, dass die Zeichenprozedur des Threads aufhört richtig zu arbeiten, kurz nachdem man mit der Maus über das TImage der Form fährt ._.

[TheGroudonx]

Hier ist die Beispielunit, ihr könnt da ja mal testen ob es bei euch auch aufhört zu arbeiten.

Edit: Ausversehen falsche Datei hochgeladen, stimmt jetzt aber...

[Bummi]

Die Art zu Locken verriegelt auch über eine globale CriticalSection (das gewählte Canvas ist hier eh "wurscht"), was heißt daß sich Deine Threads gegenseitig blockieren.
Wenn Du eine Möglichkeit sucht ohne Canvas in mehreren Threads parallel zu arbeiten um am Schluss das ganze synchronisiert auf die Oberfläche zu bringen könntest Du Dich mit GDI+ beschäftigen. Hier funktioniert es auch ohne Canvas/HDC mit GdipGetImageGraphicsContext/GdipCreateBitmapFromScan0.
Da Bilsen erst ab D2009 funktioniert und progdigy nicht mehr existiert könntest Du das benötigte bei http://lummie.co.uk/gdi-controls-for-delphi/ finden.

[Whookie]

...wie gesagt wenn du korrekt lockst/unlockst geht das (zumindestens bei mir unter xe5) problemlos...

Delphi-Quellcode:

procedure TPaintThread.Execute;
begin
 While (Terminated = False) do
 begin
   MyBild.Canvas.lock;
   Original.Canvas.Lock;
   try
     MyBild.Width := random(500) + 500;
     MyBild.Height := random(500) + 500;
     MyBild.Canvas.Draw(random(25) + 1, random(25) + 1, Original);
     MyBild.Canvas.Rectangle(random(25) + 1, random(25) + 1, random(50) + 25, random(50) + 25);
   finally
     MyBild.Canvas.unlock;
     Original.Canvas.Unlock;
   end;
   Synchronize(Zeichnen);
 end;
end;

[Medium]

Zu Bummis Vorschlag: Viel zu kompliziert. Das geht wunderbar mit Delphis ganz normalem TBitmap. Man sollte eben wie schon zuvor erwähnt, in Threads immer nur mit Kopien arbeiten, oder zumindest ein wasserdichtes Synchronisationskonzept haben. Ich habe schon zig Programme geschrieben, die auf diese Weise aufwändige Bilder parallel zeichnen. Dem TE jetzt zusätzlich zum Thema Threads auch noch mit GDI+ zu kommen, halte ich für viel zu viel auf ein Mal. (Zumal GDI+ praktisch schon totgesagt ist, und somit nicht mal viel für die Zukunft gelernt ist.)

[TheGroudonx]

Ups, habe vergessen die 2te Bitmap (original) mit zu locken/unlocken...
Das hat scheinbar einen großen Effekt gehabt.

[Bummi]

Do loops endlos

Delphi-Quellcode:

 While (Terminated = False) do
 begin

zudem erzeugst Du das Bild im Kontext des Hauptthreads (Create) , erst im Execute bist Du im Threadkontext.

[Bummi]

@Medium ich denke es hängt von den Anforderungen ab, mit Synchronisierung egal ob Canvas.Lock oder eigenen CriticalSections wird es bei mehreren fast so langsam dass man es auch im Hauptkontext laufen lassen könnte und ohne kommt es definitiv zu Fehlern, was leicht zu zeigen ist:

Delphi-Quellcode:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TTestThread=Class(TThread)
    private
    FFn:String;
    public
    Constructor Create(fn:String);overload;
    Procedure Execute;override;
  End;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TTestThread }

constructor TTestThread.Create(fn: String);
begin
  inherited Create(false);
  FFn := fn;
end;

procedure TTestThread.Execute;
var
 bmp :TBitmap;
 i:Integer;
begin
  inherited;
   bmp :=TBitmap.Create;
   bmp.Width := 100;
   bmp.Height := 100;
   bmp.Canvas.Pen.Color := clBlue;
   for I := 0 to 100 do
   begin
     bmp.Canvas.MoveTo(0,0);
     bmp.Canvas.LineTo(100,i);
   end;
   bmp.SaveToFile('C:\temp\test\' + Ffn );
   bmp.Free;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
 i:Integer;
begin
   for I := 0 to 20 do  TTestThread.Create(IntToStr(i)+'.bmp');
end;

end.