Fastest way to draw pixels in FireMonkey

I have made the following code:

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;

Is there a faster way to draw pixels in Firemonkey?
I aim to make a demo program using Conway's game of life.


All the time is spent performing these two lines of code:

ImageControl1.Canvas.BeginScene;
ImageControl1.Canvas.EndScene;

You can delete all the code that works with the bitmap and the code that actually draws the bitmap and it makes not one iota of difference to the runtime. In other words, the bottleneck is the scene code not the bitmap code. And I see no way for you to optimise that.

My test code looked like this:

Stopwatch := TStopwatch.StartNew;
for i:= 1 to 100 do begin
  ImageControl1.Canvas.BeginScene;
  ImageControl1.Canvas.EndScene;
end;
ShowMessage(IntToStr(Stopwatch.ElapsedMilliseconds));

This has the same elapsed time as your code, 1600ms on my machine. If you remove the BeginScene , DrawBitmap and EndScene calls then your code runs in 3ms on my machine.


Here is a faster way to do that :

     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;

Quick and Optimized !...


You can optimize your code like this:

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;

Removed:

  • calling try finally in loop

  • creating TBitmap in loop

  • calling TBitmap.ScanLine method

  • 链接地址: http://www.djcxy.com/p/10370.html

    上一篇: 开始使用MacRuby和Xcode 4.2

    下一篇: 在FireMonkey中绘制像素的最快方法