unit ThreadBitmap.View;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;
type
TUpdateGui = TProc<TBitmap>;
TPainter =
class(TThread)
private
fBMP: TBitmap;
fUpdateGui: TUpdateGui;
procedure DoPainting(
const ACanvas: TCanvas;
const AWitdh, AHeight: Integer);
procedure updateGui;
procedure DoUpdateGui;
protected
procedure Execute;
override;
public
constructor Create(
const AUpdateGui: TUpdateGui);
destructor Destroy;
override;
end;
TForm16 =
class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FPainter: TPainter;
procedure updateGui(ABitmap: TBitmap);
public
{ Public declarations }
end;
var
Form16: TForm16;
implementation
{$R *.fmx}
{ TPainter }
constructor TPainter.Create(
const AUpdateGui: TUpdateGui);
begin
fUpdateGui := AUpdateGui;
inherited Create(false);
end;
destructor TPainter.Destroy;
begin
fUpdateGui :=
nil;
inherited;
end;
procedure TPainter.DoPainting(
const ACanvas: TCanvas;
const AWitdh, AHeight: Integer);
var
myPoint1: TPoint;
myPoint2: TPoint;
I: Integer;
begin
myPoint1 := TPoint.Zero;
if ACanvas.BeginScene
then
begin
ACanvas.Clear(TAlphaColorRec.Null);
ACanvas.Stroke.Thickness := 1;
ACanvas.Stroke.Color := TAlphaColorRec.Black;
try
for I := 0
to 1000 - 1
do
begin
myPoint2 := TPoint.Create(Random(AWitdh), Random(AHeight));
ACanvas.DrawLine(myPoint1, myPoint2, 1);
myPoint1 := myPoint2;
end;
finally
ACanvas.EndScene;
end;
end;
end;
procedure TPainter.Execute;
begin
inherited;
fBMP := TBitmap.Create(256, 256);
try
while not Terminated
do
begin
DoPainting(fBMP.Canvas, fBMP.Width, fBMP.Height);
updateGui;
if not Terminated
then
Sleep(1000);
end;
finally
fBMP.Free;
end;
end;
procedure TPainter.DoUpdateGui;
begin
fUpdateGui(fBMP);
end;
procedure TPainter.updateGui;
begin
if Assigned(fUpdateGui)
then
begin
Synchronize(DoUpdateGui);
end;
end;
procedure TForm16.FormDestroy(Sender: TObject);
begin
if Assigned(FPainter)
then
FPainter.Free;
end;
procedure TForm16.FormCreate(Sender: TObject);
begin
FPainter :=
nil;
end;
procedure TForm16.Button1Click(Sender: TObject);
begin
FPainter := TPainter.Create(updateGui);
end;
procedure TForm16.updateGui(ABitmap: TBitmap);
var
LBitmap: TBitmap;
LDataWrite, LDataRead: TBitmapData;
begin
// Self.Image1.BeginUpdate;
// try
// Self.Image1.Bitmap.SetSize(ABitmap.Size);
// Self.Image1.Bitmap.Assign(ABitmap);
// finally
// Self.Image1.EndUpdate;
// Self.Image1.Repaint;
// end;
Self.Image1.BeginUpdate;
try
LBitmap := Self.Image1.Bitmap;
LBitmap.SetSize(ABitmap.Size);
if LBitmap.Map(TMapAccess.
Write, LDataWrite)
and ABitmap.Map(TMapAccess.
Read, LDataRead)
then
begin
try
LDataWrite.Copy(LDataRead);
finally
ABitmap.Unmap(LDataRead);
LBitmap.Unmap(LDataWrite);
end;
end;
finally
Self.Image1.EndUpdate;
Self.Image1.Repaint;
end;
end;
end.