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

发布于 2024-12-28 16:42:58 字数 818 浏览 1 评论 0 原文

我编写了以下代码：

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

原文

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.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

坏尐絯℡ 2025-01-04 16:42:58

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

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 毫秒。

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.

回复收藏 0 原文

晨光如昨 2025-01-04 16:42:58

您可以像这样优化代码：

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 方法< /p>

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

回复收藏 0 原文

荒人说梦 2025-01-04 16:42:58

这是一种更快的方法：

     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;

快速且优化！...

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 !...

回复收藏 0 原文

~没有更多了~