Hallo,

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

zusammenfalten · markieren

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 ?

Zitat von calibra301:

zusammenfalten · markieren

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.

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.

Zitat von calibra301:

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.

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

Hallo,

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