在 FireMonkey 中绘制像素的最快方法答案

【问题标题】：Fastest way to draw pixels in FireMonkey在 FireMonkey 中绘制像素的最快方法
【发布时间】：2012-01-24 14:03:25
【问题描述】：

我做了以下代码：

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 中绘制像素？
我的目标是使用康威的生活游戏制作一个演示程序。

【问题讨论】：

你的 Firemonkey 是什么版本？在柏林 10.1 中，代码不起作用。

标签： delphi delphi-xe2 firemonkey

【解决方案1】：

所有时间都花在执行这两行代码上：

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));

这与您的代码的运行时间相同，在我的机器上为 1600 毫秒。如果您删除 BeginScene、DrawBitmap 和 EndScene 调用，那么您的代码在我的机器上运行时间为 3 毫秒。

【讨论】：

经过测试发现beginscene-endscene 对是必不可少的。如果 that 占用了所有的运行时间，我就卡住了。我将查看开始和结束场景的源代码，看看是什么占用了所有运行时，我认为那里有一些线程保护代码（关键部分或诸如此类）会减慢速度。
在单线程应用程序中，关键部分不会拖慢您的速度。 70fps 似乎对于一款无绘图应用来说有点偏低。

【解决方案2】：

你可以像这样优化你的代码：

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;

已删除：

在循环中调用tryfinally
在循环中创建TBitmap
调用TBitmap.ScanLine方法

【讨论】：

我修复了一些明显的错误，但画布不会每次都通过i 更新。我们不必担心 FireMonkey 位图上的填充吗？您也可以将im:= ImageControl1; 排除在外。尝试添加Bitmap1.UpdateHandles; 来更新位图。
谢谢，我现在没有 XE2。下一个选项是尝试将TImage 放在表单上，Image1.Bitmap := Bitmap1; 用于缓冲区复制操作。
这需要完全相同的时间，但实际上不起作用。它与问题中的代码不同。
您不能从原始代码示例中删除 TBitmap.Scanline 否则位图根本不会被修改
感谢您的尝试，但您的代码实际上并没有按预期工作，而不是显示 100x，它只显示 1x，由于某种原因，如果您不每次都重新创建位图（或使用 UpdateHandles）它确实无法识别更改并且不显示任何新内容。最重要的是，它需要基本上相同数量的 CPU 时间。（原因见大卫的回答）。

【解决方案3】：

这是一种更快的方法：

     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;

快速优化！...

【讨论】：