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.