delphi 为什么一个有500个组件的表单很慢?

yr9zkbsy  于 12个月前  发布在  其他
关注(0)|答案(3)|浏览(91)

我正在创建一个有图标的表单-就像在桌面上一样,它们可以自由移动。我想有时甚至显示500个或更多的图标,所以他们需要快速工作。我的图标是:
TMyIcon = class(TGraphicControl)
所以它没有Windows句柄。绘图是:

  • 1 x画布。矩形(约64 x32)
  • 1 x Canvas.TextOut(比矩形小一点)
  • 1 x Canvas.Draw(图像为32 x32)

移动东西的代码是这样的:MyIconMouseMove:

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

字符串
在窗体上通常有大约50个图标-其余的都在可见区域之外。当我有100个图标时-我可以自由移动它们,并且工作得很快。但是当我创建500个图标时,它就会变得滞后-但可见图标的数量仍然是一样的。我如何告诉Windows完全忽略不可见图标,以便一切顺利?
或者可能有一个组件可以显示类似桌面的图标,并能够移动它们?比如TShellListView with AutoArrange = False?

bcs8qyzn

bcs8qyzn1#

TGraphicControl是一个没有自己的句柄的控件。它使用其父控件来显示其内容。这意味着,更改控件的外观将迫使父控件也被重绘。这也可能触发重绘所有其他控件。
理论上,只有父控件X所在的部分需要被无效化,因此只有与该部分重叠的控件才需要被重新绘制。但是,这仍然可能导致连锁React,导致每次更改其中一个控件中的单个像素时,都会调用大量的绘制方法。
显然,可见区域之外的图标也会被重新绘制。我认为你可以通过将可见区域之外的图标的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;

字符串
然后,graphiccontrol本身:

{ 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在您的情况下)。

nlejzf6q

nlejzf6q2#

你可能想看看这个控件,这正是你所要求的。
rkView from RMKlever
它基本上是一个图标或照片缩略图浏览器与滚动等。

qvk1mo1f

qvk1mo1f3#

如果您使用application.onMessage,请验证您的实现函数。
我在使用这个的时候遇到了一个问题。我的函数使用application.onmessage交换了被聚焦的组件的颜色;这样,表单中的组件加载得非常慢。

相关问题