Самый быстрый способ рисования пикселей в FireMonkey
Я сделал следующий код:
procedure TForm15.Button1Click(Sender: TObject);
var
Bitmap1: TBitmap;
im: TImageControl;
Color: TColor;
Scanline: PAlphaColorArray;
x,y,i: Integer;
begin
for i:= 1 to 100 do begin
im:= ImageControl1;
Bitmap1:= TBitmap.Create(100,100);
try
for y:= 0 to 99 do begin
ScanLine:= Bitmap1.ScanLine[y];
for x:= 0 to 99 do begin
ScanLine[x]:= Random(MaxInt);
end;
end;
ImageControl1.Canvas.BeginScene;
ImageControl1.Canvas.DrawBitmap(Bitmap1, RectF(0,0,Bitmap1.Width, Bitmap1.Height)
,im.ParentedRect,1,true);
ImageControl1.Canvas.EndScene;
finally
Bitmap1.Free;
end;
end;
end;
есть ли более быстрый способ рисовать пиксели в Firemonkey?
Я намереваюсь сделать демо-программу, используя игру жизни Конвея.
3 ответов
все время тратится на выполнение этих двух строк кода:
ImageControl1.Canvas.BeginScene;
ImageControl1.Canvas.EndScene;
вы можете удалить весь код, который работает с растровым изображением, и код, который фактически рисует растровое изображение, и это не имеет ни малейшего значения для среды выполнения. Другими словами, узким местом является код сцены, а не растровый код. И я не вижу способа для вас оптимизировать это.
мой тестовый код выглядит так:
Stopwatch := TStopwatch.StartNew;
for i:= 1 to 100 do begin
ImageControl1.Canvas.BeginScene;
ImageControl1.Canvas.EndScene;
end;
ShowMessage(IntToStr(Stopwatch.ElapsedMilliseconds));
это имеет то же время, что и ваш код, 1600ms на моем машина. Если убрать BeginScene
, DrawBitmap
и EndScene
вызовы, то ваш код работает в 3ms на моей машине.
вот более быстрый способ сделать это:
procedure TForm2.Button1Click(Sender: TObject);
var i,j: integer;
begin
for i := 0 to 200 do
for j := 0 to 200 do ImageControl1.Bitmap.ScanLine[i][j]:=Random(Maxlongint);
ImageControl1.Bitmap.BitmapChanged;
end;
быстрый и оптимизированный !...
вы можете оптимизировать свой код следующим образом:
procedure TForm15.Button1Click(Sender: TObject);
var
Bitmap1: TBitmap;
im: TImageControl;
Color: TColor;
ScanLine: PAlphaColorArray;
x,y,i: Integer;
begin
Bitmap1:= TBitmap.Create(100,100);
try
for i:= 1 to 100 do begin
im:= ImageControl1;
Scanline := PAlphaColorArray(Bitmap1.StartLine);
for x := 0 to Bitmap1.Width * Bitmap1.Height do
ScanLine[x] := Random(MaxInt);
ImageControl1.Canvas.BeginScene;
ImageControl1.Canvas.DrawBitmap(Bitmap1, RectF(0,0,Bitmap1.Width, Bitmap1.Height)
,im.ParentedRect,1,true);
ImageControl1.Canvas.EndScene;
end;
finally
Bitmap1.Free;
end;
end;
удалено:
вызов
try
finally
в циклесоздания
TBitmap
в циклевызов
TBitmap.ScanLine
метод