Threads und TBitmaps...schon wieder :-)

[calibra301]

Hallo,

das Thema Bitmaps / Threadsicherheit ist hier ja schon öfter aufgetaucht.
Hab hier auch diesen Code gefunden der für mich auch funktioniert.

Delphi-Quellcode:

unit Unit2;

interface

uses
dbgmsgs,
  Winapi.Windows, SyncObjs,
  System.Classes, Vcl.Graphics;

type
  TImageRenderer = class(TThread)
  private
    fBmp: TBitmap;
    fOnPaint: TNotifyEvent;
    procedure PaintBmp;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    property OnPaint: TNotifyEvent read fOnPaint write fOnPaint;
  end;

implementation

uses
  Unit1;

{ ImageRenderer }

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;



end.


// Formularseite
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit2, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    ICntLbl: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    fRT: TImageRenderer;
    procedure IRTerminate(Sender: TObject);
    procedure IRPaint(Sender: TObject);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Not Assigned(fRT) then
  begin
    Image1.Picture.Bitmap.SetSize(200,200);
    Image1.Picture.Bitmap.Canvas.Brush.Color := RGB(Random(256),Random(256),Random(256));
    Image1.Picture.Bitmap.Canvas.FillRect(Rect(0,0,200,200));

    fRT := TImageRenderer.Create;
    fRT.OnTerminate := IRTerminate;
    fRT.FreeOnTerminate := TRUE;
    fRT.OnPaint := IRPaint;
    Button1.Caption := 'Stop';
  end
  else
  begin
    fRT.Terminate;
    Button1.Caption := 'Go';
  end;
end;

procedure TForm1.IRTerminate(Sender: TObject);
begin
  fRT := NIL;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(fRT) then
    fRT.Terminate;
end;

procedure TForm1.IRPaint(Sender: TObject);
Var
  iBmp: TBitmap;
begin
  iBmp := Sender As TBitmap;
  Image1.Picture.Bitmap.Canvas.Draw(10,10, iBmp);
  //--------------------------------------------
  ICntLbl.Tag := ICntLbl.Tag + 1;
  ICntLbl.Caption := IntToStr(ICntLbl.Tag);
end;

end.

IRPaint wird ja nach dem Zeichnen aufgerufen, klappt alles auch soweit.

Nun würde ich gern in der TImageRenderer.Execute eine Schleife laufen lassen die
Daten aus verschiedenen Buffern holt und in einen Array of Bitmap zeichnet.

Wenn alle 10 Arrays gezeichnet sind IRPaint auslösen und im Mainform einen
Array of Bitmap mit den neuen Bitmaps die im Thread gezeichnet wurden füllen.

Wie geht man das an ? Pointer auf ein TBitmap Array ?

[Sinspin]

Zitat:

Zitat von calibra301 (Beitrag 1532466)

Delphi-Quellcode:

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;

Das ist eine ganz blöde Idee. Canvas.Pixel ist Grottenlahm.
Du setzt doch eh schon pf24Bit. Das ist wie gemacht für einen Zugriff via TBitmap.Scanline!

Wenn Du die Bilder innerhalb des Threads erzeugst würde ich aber ganz auf TBitmap verzichten und lieber mit einem RGB Raster also array of TRGB...(packed record R,G,B:Byte;end) arbeiten.
Das geht noch schneller in dem Moment wie du bereit bist ein weiteres Byte zu spenden, egal ob du es brauchst oder nicht. -> TRGBX...(record R,G,B,X:Byte;end) weil dann der Compiler die Zugriffe weiter optimieren kann.

[calibra301]

Danke für den Tipp,

Speed ist da relativ wichtig. Das zu zeichnende ist ein Koordinatenhaufen aus X/Y/R/G/B.
Also Vektorgrafiken mit 100-500 Punkten.

Die im Thread gleich in ein TBitmap zu packen kam mir am einfachstem vor weil ich die Bitmaps
ja im Mainthread in die bis zu 40 TImages packen möchte.

[jaenicke]

Zitat:

Zitat von calibra301 (Beitrag 1532483)

Die im Thread gleich in ein TBitmap zu packen kam mir am einfachstem vor weil ich die Bitmaps
ja im Mainthread in die bis zu 40 TImages packen möchte.

Da hast du aber auch entsprechenden Overhead. Wenn du im Thread nur mit den Daten arbeitest, hast du keinerlei Threadprobleme, weil keine Windows Handles oder Grafikklassen involviert sind. Die Daten kannst du dann einfach herausreichen und zeilenweise (wie schon genannt mit ScanLine) den jeweiligen Speicherbereich in eine TBitmap schieben.

[Redeemer]

Wenn du schon auf Pixels zugreifen musst, dann TPngimage. Das ist schneller als TBitmap.Canvas. Überhaupt arbeite ich gerne mit TPngimage.

[calibra301]

Hallo,

zum zeichnen brauche ich nur Pen.color, moveto und lineto

[Rollo62]

Oder Image32
https://github.com/AngusJohnson/Image32
Habs nicht probiert, aber sollte auch im Thread nutzbar sein, wenn man es nicht rendern lässt.

[Benmik]

Ich habe die Frage, ob die Verwendung von TBitmap multithreaded auch dann kritisch ist, wenn das Bitmap nur jeweils von einem Thread bearbeitet und ansonsten nicht weiter angefasst wird. Ich erstelle Vorschaubilder aus JPG, speichere sie in einer Liste und zeichne sie bei Bedarf auf einen Canvas.

[peterbelow]

Du solltest auf jeden Fall den Kode der mit einem Canvas arbeitet in

Delphi-Quellcode:

   Canvas.Lock;
   try
     Zeichnen hier
   finally
     Canvas.Unlock;
   end;

einschließen ("Canvas" muss natürlich durch den Bezeichner des Canvas ersetzt werden, den Du da verwendest.)
Die VCL hat eine interne Verwaltung von GDI-Objekten wie Font, Pen, Brush um GDI-Handles zu sparen und die ist nicht thread-safe. Die Lock/Unlock Aufrufe beheben das.

[Benmik]

Hallo Peter, vielen Dank für deine Antwort. Die Sachen mit Objekten wie Font, Pen, Brush usw. hatte ich schon mal gehört, und auch, dass

Delphi-Quellcode:

Canvas.Lock

Pflicht ist. Dass es da eine interne Verwaltung von GDI-Objekten gibt, um GDI-Handles zu sparen, erklärt es mir. Es ist natürlich blöd, aber irgendwie wollte ich mich gern um das Lock drücken, weil ich da Geschwindigkeitseinbußen vermutete; habe es allerdings nie nachgemessen. Es kam früher immer wieder mal zu Exceptions beim Einlesen von sehr vielen Bildern und dementsprechender Erstellung von BMP, aber in letzter Zeit nicht mehr. Ist natürlich kein Umgang damit. Ich werde jetzt mal das Lock setzen und auch mal nachmessen, ob das wirklich spürbar Zeit kostet.