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

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?

markieren

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

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

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

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.

Hier mal so ein BitmapThread

zusammenfalten · markieren

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

zusammenfalten · markieren

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

zusammenfalten · markieren

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.

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