为什么包含500个组件的表单会变慢？

Question

我正在创建一个表单，其中有图标-就像在桌面上一样，它们可以自由移动。 我希望有时甚至显示500个或更多的图标，因此它们需要快速运行。

我的图标是：

TMyIcon = class(TGraphicControl)

因此它没有Windows句柄。绘图内容如下：

• 1 x Canvas.Rectangle（大约为64x32）
• 1 x Canvas.TextOut（比矩形略小）
• 1 x Canvas.Draw（图像为32x32）

移动图标的代码如下：

MyIconMouseMove：

Ico.Left := Ico.Left + X-ClickedPos.X;
Ico.Top  := Ico.Top  + Y-ClickedPos.Y;

在表单上通常有大约50个图标-其余的在可见区域之外。 当我有100个图标时-我可以自由移动它们，这很快。但是当我创建500个图标时，它就会变得卡顿，但是可见图标数仍然相同。 如何让 Windows 完全忽略不可见的图标，以便一切都能顺利运行？

或者，有没有组件可以显示类似桌面的图标，并具有移动它们的功能？类似于 TShellListView，其中 AutoArrange = False？

- Tom

---

不要描述代码，你能展示一下代码吗？ - David Heffernan

@Mason Wheeler: 我也有同样的想法。如果一个问题真的很糟糕（这里不是这种情况），那么投票下降是可以的，但是投票者应该至少留下建设性的评论来说明如何改进问题。 - Wouter van Nifterick

@DavidHeffernan 我认为在这里展示代码并不重要。更关键的是问题本身（如何告诉Windows忽略这些组件并不再绘制它们），而不是实际的代码。 - Tom

Answer 1

TGraphicControl是一种没有自己处理的控件。它使用它的父控件来显示其内容。这意味着，改变您的控件外观将强制重绘父控件。这也可能触发重新绘制所有其他控件。

理论上，只需要使控件X定位的父窗口的部分无效，因此应该只需要重绘重叠该部分的控件。但是，这可能会引起连锁反应，每次更改其中一个控件中的单个像素时都会调用许多绘制方法。

显然，还会重绘可见区域外的图标。我认为，如果图标在可见区域之外，可以通过将其Visible属性设置为False来优化此过程。

如果这样不起作用，您可能需要完全不同的方法：有一种选项可以在单个控件上绘制所有图标，从而使您可以缓冲图像。如果您正在拖动图标，则可以一次将所有其他图标绘制在位图上。在每次鼠标移动时，您只需要绘制该缓冲位图和被拖动的单个图标，而不是100（或500）个单独的图标。这应该可以加快速度，尽管需要更多的开发投入。

您可以这样实现：

type
  // A class to hold icon information. That is: Position and picture
  TMyIcon = class
    Pos: TPoint;
    Picture: TPicture;
    constructor Create(Src: TBitmap);
    destructor Destroy; override;
  end;

  // A list of such icons
  //TIconList = TList<TMyIcon>;
  TIconList = TList;

  // A single graphic controls that can display many icons and 
  // allows dragging them
  TIconControl = class(TGraphicControl)
    Icons: TIconList;
    Buffer: TBitmap;
    DragIcon: TMyIcon;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Initialize;
    // Painting
    procedure ValidateBuffer;
    procedure Paint; override;
    // Dragging
    function IconAtPos(X, Y: Integer): TMyIcon;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  end;


{ TMyIcon }

// Some random initialization 
constructor TMyIcon.Create(Src: TBitmap);
begin
  Picture := TPicture.Create;
  Picture.Assign(Src);
  Pos := Point(Random(500), Random(400));
end;

destructor TMyIcon.Destroy;
begin
  Picture.Free;
  inherited;
end;

然后是图形控件本身：

{ TIconControl }

constructor TIconControl.Create(AOwner: TComponent);
begin
  inherited;
  Icons := TIconList.Create;
end;

destructor TIconControl.Destroy;
begin
  // Todo: Free the individual icons in the list.
  Icons.Free;
  inherited;
end;

function TIconControl.IconAtPos(X, Y: Integer): TMyIcon;
var
  r: TRect;
  i: Integer;
begin
  // Just return the first icon that contains the clicked pixel.
  for i := 0 to Icons.Count - 1 do
  begin
    Result := TMyIcon(Icons[i]);
    r := Rect(0, 0, Result.Picture.Graphic.Width, Result.Picture.Graphic.Height);
    OffsetRect(r, Result.Pos.X, Result.Pos.Y);
    if PtInRect(r, Point(X, Y)) then
      Exit;
  end;
  Result := nil;
end;


procedure TIconControl.Initialize;
var
  Src: TBitmap;
  i: Integer;
begin
  Src := TBitmap.Create;
  try
    // Load a random file.
    Src.LoadFromFile('C:\ff\ff.bmp');

    // Test it with 10000 icons.
    for i := 1 to 10000 do
      Icons.Add(TMyIcon.Create(Src));

  finally
    Src.Free;
  end;
end;

procedure TIconControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Button = mbLeft then
  begin
    // Left button is clicked. Try to find the icon at the clicked position
    DragIcon := IconAtPos(X, Y);
    if Assigned(DragIcon) then
    begin
      // An icon is found. Clear the buffer (which contains all icons) so it
      // will be regenerated with the 9999 not-dragged icons on next repaint.
      FreeAndNil(Buffer);

      Invalidate;
    end;
  end;
end;

procedure TIconControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(DragIcon) then
  begin
    // An icon is being dragged. Update its position and redraw the control.
    DragIcon.Pos := Point(X, Y);

    Invalidate;
  end;
end;

procedure TIconControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if (Button = mbLeft) and Assigned(DragIcon) then
  begin
    // The button is released. Free the buffer, which contains the 9999
    // other icons, so it will be regenerated with all 10000 icons on
    // next repaint.
    FreeAndNil(Buffer);
    // Set DragIcon to nil. No icon is dragged at the moment.
    DragIcon := nil;

    Invalidate;
  end;
end;

procedure TIconControl.Paint;
begin
  // Check if the buffer is up to date.
  ValidateBuffer;

  // Draw the buffer (either 9999 or 10000 icons in one go)
  Canvas.Draw(0, 0, Buffer);

  // If one ican was dragged, draw it separately.
  if Assigned(DragIcon) then
    Canvas.Draw(DragIcon.Pos.X, DragIcon.Pos.Y, DragIcon.Picture.Graphic);
end;

procedure TIconControl.ValidateBuffer;
var
  i: Integer;
  Icon: TMyIcon;
begin
  // If the buffer is assigned, there's nothing to do. It is nilled if
  // it needs to be regenerated.
  if not Assigned(Buffer) then
  begin
    Buffer := TBitmap.Create;
    Buffer.Width := Width;
    Buffer.Height := Height;
    for i := 0 to Icons.Count - 1 do
    begin
      Icon := TMyIcon(Icons[i]);
      if Icon <> DragIcon then
        Buffer.Canvas.Draw(Icon.Pos.X, Icon.Pos.Y, Icon.Picture.Graphic);
    end;
  end;
end;

创建其中一个控件，使其填满表单并使用10000个图标进行初始化。

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;

  with TIconControl.Create(Self) do
  begin
    Parent := Self;
    Align := alClient;
    Initialize;
  end;
end;

这个方法可能有些粗糙，但它显示这个解决方案可能非常有效。如果你开始拖动（按下鼠标），你会注意到一个小延迟，因为10000个图标被绘制在位图缓冲区上。之后，在拖动时没有明显的延迟，因为每次重绘只绘制两张图片（而不是您的情况下的500张）。

- GolezTrol

---

今天下午我没有时间，但现在我添加了一个小例子，展示如何在单个控件中管理10000个图标，并实现合理快速的拖放。 - GolezTrol

谢谢，看起来很有前途。无法在Lazarus或Delphi 2005中编译它，因为有像TList <TMyIcon>这样的东西，但也许经过一些更改后可以变得有用。 - Tom

啊，我试图使用更近期的功能，不知道你的Delphi版本。TList<TMyIcon>意味着“TMyIcons列表”。在Delphi 2005中，您只需使用TList，但需要稍微更改for循环并在检索时将项目强制转换为TMyIcon。 - GolezTrol

我已经更改了TIconList的声明以及IconAtPos和ValidateBuffer中的for循环。这使得它可以在D2007中编译。它应该也可以在D2005中编译，尽管我无法测试。 - GolezTrol

函数：TIconControl.IconAtPos() 在有10k个项目时速度有点慢，所以我会进行优化，但除此之外，这真是一件不错的事情。再次感谢！ - Tom

Answer 2

你可能想要查看这个控件，它正是你所需要的。 rkView from RMKlever 基本上它是一个带有滚动等功能的图标或照片缩略图查看器。

- Warren P

---

看起来很有前途，但是没有演示，没有文档，而且它不仅仅是一个ListView的替代品，所以我还不知道如何使用它。 - Tom

它真的需要一个简单的演示。也许我会做一个，因为Klever先生太好了，可以制作控件。他有一个演示，但是这个演示非常难以构建和使用：http://rmklever.com/?p=318 - Warren P

我找到了他的另一个演示：http://rmklever.com/?p=266，但它也相当复杂。老实说，我以前曾多次访问过这个网站，下载了组件，但由于没有软件包、演示和大量依赖项，我从未找到时间编译出任何东西。 - Tom

Answer 3

如果您使用application.onMessage，请验证您的实现函数。

我在使用它时遇到了问题。我的函数通过application.onMessage来交换焦点所在组件的颜色；由于这个原因，加载表单中的组件非常缓慢。

- Marcelo Marques