性能问题：在窗体调整大小时重新调整大量组件的大小

Question

我觉得我的失败在于搜索关键词，因为这方面的信息应该很普遍。基本上，我正在寻找在调整表单大小时调整多个组件的常见解决方案和最佳实践。

我有一个基于 TScrollBox 的组件表单。滚动框包含在运行时动态添加的行。它们基本上是子组件。每个行左侧有一个图像，右侧有一个备忘录。高度根据图像的宽度和长宽比设置。在滚动框调整大小时，循环设置行的宽度，从而触发行自身的内部调整大小。如果高度发生变化，循环还会设置相对顶部位置。

屏幕截图：

大约16行表现良好。我的目标更接近32行，这非常卡顿，可能会将一个核心的使用率提高到100%。

我已经尝试过：

• 添加了一个检查，以防止新的调整大小在之前完成之前开始。如果发生了，它会回答，并且有时确实会发生。
• 我尝试防止每30毫秒调整大小一次，这将允许每秒绘制30帧。效果不稳定。
• 将行基本组件从TPanel更改为TWinControl。不确定使用Panel是否存在性能惩罚，但这是一个老习惯。
• 使用和不使用双缓冲。

我希望在调整大小期间允许行调整大小，以预览行中图像的大小。这消除了一个显而易见的解决方案，在某些应用程序中是可以接受的损失。

现在，行的调整大小代码在内部完全动态，并基于每个图像的尺寸。我计划尝试的下一件事情是基本上指定纵横比、最大宽度/高度，这取决于集合中最大的图像。这应该减少每行的计算量。但似乎问题更多的是调整大小事件和循环本身？

组件的完整单元代码：

unit rPBSSVIEW;

interface

uses
  Classes, Controls, Forms, ExtCtrls, StdCtrls, Graphics, SysUtils, rPBSSROW, Windows, Messages;

type
  TPBSSView = class(TScrollBox)
  private    
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResizeRows(Sender: TObject);
    procedure AddRow(FileName: String);
    procedure FillRow(Row: Integer; ImageStream: TMemoryStream);
  end;

var
  PBSSrow: Array of TPBSSRow;
  Resizingn: Boolean;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TScrollBox]);
end;

procedure TPBSSView.AddRow(FileName: String);
begin
  SetLength(PBSSrow,(Length(PBSSrow) + 1));
  PBSSrow[Length(PBSSrow)-1] := TPBSSRow.create(self);
  With PBSSrow[Length(PBSSrow)-1] do
  begin
    Left := 2;
    if (Length(PBSSrow)-1) = 0 then Top := 2 else Top := ((PBSSRow[Length(PBSSRow) - 2].Top + PBSSRow[Length(PBSSRow) - 2].Height) + 2);
    Width := (inherited ClientWidth - 4);
    Visible := True;
    Parent := Self;
    PanelLeft.Caption := FileName;
  end;
end;

procedure TPBSSView.FillRow(Row: Integer; ImageStream: TMemoryStream);
begin
  PBSSRow[Row].LoadImageFromStream(ImageStream);
end;

procedure TPBSSView.ResizeRows(Sender: TObject);
var
  I, X: Integer;
begin
  if Resizingn then exit
  else
  begin
      Resizingn := True;
      HorzScrollBar.Visible := False;
      X := (inherited ClientWidth - 4);
      if Length(PBSSrow) > 0 then
      for I := 0 to Length(PBSSrow) - 1 do
      Begin
        PBSSRow[I].Width := X; //Set Width
        if not (I = 0) then      //Move all next ones down.
          begin
            PBSSRow[I].Top := (PBSSRow[(I - 1)].Top + PBSSRow[(I - 1)].Height) + 2;
          end;
        Application.ProcessMessages;
      End;
    HorzScrollBar.Visible := True;
    Resizingn := False;
  end;
end;

constructor TPBSSView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  OnResize := ResizeRows;
  DoubleBuffered := True;
  VertScrollBar.Tracking := True;
  Resizingn := False;
end;

destructor TPBSSView.Destroy;
begin
  inherited;
end;

end.

行代码：

unit rPBSSROW;

interface

uses
  Classes, Controls, Forms, ExtCtrls, StdCtrls, Graphics, pngimage, SysUtils;

type
  TPBSSRow = class(TWinControl)
  private
    FImage: TImage;
    FPanel: TPanel;
    FMemo: TMemo;
    FPanelLeft: TPanel;
    FPanelRight: TPanel;
    FImageWidth: Integer;
    FImageHeight: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MyPanelResize(Sender: TObject);
    procedure LeftPanelResize(Sender: TObject);
  published
    procedure LoadImageFromStream(ImageStream: TMemoryStream);
    property Image: TImage read FImage;
    property Panel: TPanel read FPanel;
    property PanelLeft: TPanel read FPanelLeft;
    property PanelRight: TPanel read FPanelRight;
  end;

procedure Register;    

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TWinControl]);
end;

procedure TPBSSRow.MyPanelResize(Sender: TObject);
begin
  if (Width - 466) <= FImageWidth then FPanelLeft.Width := (Width - 466)
else FPanelLeft.Width := FImageWidth;
  FPanelRight.Width := (Width - FPanelLeft.Width);
end;

procedure TPBSSRow.LeftPanelResize(Sender: TObject);
var
  AspectRatio: Extended;
begin
  FPanelRight.Left := (FPanelLeft.Width);
  //Enforce Info Minimum Height or set Height
  if FImageHeight > 0 then  AspectRatio := (FImageHeight/FImageWidth) else
  AspectRatio := 0.4;
  if (Round(AspectRatio * FPanelLeft.Width)) >= 212 then
  begin
    Height := (Round(AspectRatio * FPanelLeft.Width));
    FPanelLeft.Height := Height;
    FPanelRight.Height := Height;
  end
  else
  begin
    Height :=212;
    FPanelLeft.Height := Height;
    FPanelRight.Height := Height;
  end;
  if Fimage.Height >= FImageHeight then FImage.Stretch := False else Fimage.Stretch := True;
  if Fimage.Width >= FImageWidth then FImage.Stretch := False else Fimage.Stretch := True;
end;

procedure TPBSSRow.LoadImageFromStream(ImageStream: TMemoryStream);
var
  P: TPNGImage;
  n: Integer;
begin
  P := TPNGImage.Create;
  ImageStream.Position := 0;
  P.LoadFromStream(ImageStream);
  FImage.Picture.Assign(P);
  FImageWidth := P.Width;
  FImageHeight := P.Height;
end;

constructor TPBSSRow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BevelKind :=  bkNone;
    Color := clWhite;
    OnResize := MyPanelResize;
    DoubleBuffered := True;
  //Left Panel for Image
  FPanelLeft := TPanel.Create(Self);
  with FPanelLeft do
  begin
    SetSubComponent(true);
    Align := alLeft;
    Parent := Self;
    //SetBounds(0,0,100,100);
    ParentBackground := False;
    Color := clBlack;
    Font.Color := clLtGray;
    Constraints.MinWidth := 300;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BevelKind :=  bkNone;
    BorderStyle := bsNone;
    OnResize := LeftPanelResize;
  end;
  //Image for left panel
  FImage := TImage.Create(Self);
  FImage.SetSubComponent(true);
  FImage.Align := alClient;
  FImage.Parent := FPanelLeft;
  FImage.Center := True;
  FImage.Stretch := True;
  FImage.Proportional := True;
  //Right Panel for Info
  FPanelRight := TPanel.Create(Self);
  with FPanelRight do
  begin
    SetSubComponent(true);
    Parent := Self;
    Padding.SetBounds(2,5,5,2);
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BevelKind :=  bkNone;
    BorderStyle := bsNone;
    Color := clLtGray;
  end;

  //Create Memo in Right Panels
  FMemo := TMemo.create(self);
  with FMemo do
  begin
    SetSubComponent(true);
    Parent := FPanelRight;
    Align := alClient;
    BevelOuter := bvNone;
    BevelInner := bvNone;
    BorderStyle := bsNone;
    Color := clLtGray;
  end;

end;

destructor TPBSSRow.Destroy;
begin
  inherited;
end;

end.

- Brian Holloway

---

你可以尝试使用 LockWindowUpdate(handle); <your Loop> LockWindowUpdate(0); - bummi

阅读LockWindowUpdate的文档。这是那些API函数之一，通常会像滥用ProcessMessages一样被滥用。 - David Heffernan

我们想要看到的是最简单的例子。 - David Heffernan

没有加载图片，高度调整就不会生效。唯一可移除的是鼠标滚轮和PNG块，只需要几行代码即可完成。但是，针对这些问题已经做出了处理。300像素的限制实际上是添加到一个面板上的，因为没有加载图片会导致大小调整混乱。 - Brian Holloway

@J - 虽然使用DirectX/OpenGL始终有提高图形性能的空间，但我从未见过像Nikon ViewNX这样的程序使用DirectX来列出带有属性数据的图像行。 @NGLN 这个寄存器是从一个示例中得到的，我从未注册该组件。我不确定如何回答。我们永远不知道图像大小，直到用户加载它们的那一刻。这些图像是从FTP服务器下载的。未知的图像属性，未知的行数。有一些不必要的设计代码用于测试。这是100个开发阶段中的第1个组件，我正在处理一个更大的应用程序中的1个组件。 - Brian Holloway

Answer 1

一些提示：

• TWinControl 已经是一个容器，您不需要在其中再放置另一个面板来添加控件。
• 您不需要使用 TImage 组件来查看图像，可以使用 TPaintBox 或者像下面我的示例控件一样使用 TCustomControl。
• 由于所有其他面板都不可识别（边框和斜角被禁用），因此完全可以将它们全部去除，并将 TMemo 直接放在行控件上。
• SetSubComponent 只用于设计时。您不需要它。也不需要 Register 过程。
• 将全局行数组放在类定义中，否则多个 TPBSSView 控件将使用同一个数组！
• TWinControl 已经跟踪了其所有子控件，所以您无需使用数组，可以参考下面的示例。
• 利用 Align 属性可以避免手动重新对齐。
• 如果 Memo 控件仅用于显示文本，请将其删除并自己绘制文本。

从这里开始尝试吧：

unit PBSSView;

interface

uses
  Windows, Messages, Classes, Controls, SysUtils, Graphics, ExtCtrls, StdCtrls,
  Forms, PngImage;

type
  TPBSSRow = class(TCustomControl)
  private
    FGraphic: TPngImage;
    FStrings: TStringList;
    function ImageHeight: Integer; overload;
    function ImageHeight(ControlWidth: Integer): Integer; overload;
    function ImageWidth: Integer; overload;
    function ImageWidth(ControlWidth: Integer): Integer; overload;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
      message WM_WINDOWPOSCHANGING;
  protected
    procedure Paint; override;
    procedure RequestAlign; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadImageFromStream(Stream: TMemoryStream);
    property Strings: TStringList read FStrings;
  end;

  TPBSSView = class(TScrollBox)
  private
    function GetRow(Index: Integer): TPBSSRow;
    procedure WMEnterSizeMove(var Message: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMExitSizeMove(var Message: TMessage); message WM_EXITSIZEMOVE;
  protected
    procedure PaintWindow(DC: HDC); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AddRow(const FileName: TFileName);
    procedure FillRow(Index: Integer; ImageStream: TMemoryStream);
    property Rows[Index: Integer]: TPBSSRow read GetRow;
  end;

implementation

{ TPBSSRow }

constructor TPBSSRow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 300;
  Height := 50;
  FStrings := TStringList.Create;
end;

destructor TPBSSRow.Destroy;
begin
  FStrings.Free;
  FGraphic.Free;
  inherited Destroy;
end;

function TPBSSRow.ImageHeight: Integer;
begin
  Result := ImageHeight(Width);
end;

function TPBSSRow.ImageHeight(ControlWidth: Integer): Integer;
begin
  if (FGraphic <> nil) and not FGraphic.Empty then
    Result := Round(ImageWidth(ControlWidth) * FGraphic.Height / FGraphic.Width)
  else
    Result := Height;
end;

function TPBSSRow.ImageWidth: Integer;
begin
  Result := ImageWidth(Width);
end;

function TPBSSRow.ImageWidth(ControlWidth: Integer): Integer;
begin
  Result := ControlWidth div 2;
end;

procedure TPBSSRow.LoadImageFromStream(Stream: TMemoryStream);
begin
  FGraphic.Free;
  FGraphic := TPngImage.Create;
  Stream.Position := 0;
  FGraphic.LoadFromStream(Stream);
  Height := ImageHeight + Padding.Bottom;
end;

procedure TPBSSRow.Paint;
var
  R: TRect;
begin
  Canvas.StretchDraw(Rect(0, 0, ImageWidth, ImageHeight), FGraphic);
  SetRect(R, ImageWidth, 0, Width, ImageHeight);
  Canvas.FillRect(R);
  Inc(R.Left, 10);
  DrawText(Canvas.Handle, FStrings.Text, -1, R, DT_EDITCONTROL or
    DT_END_ELLIPSIS or DT_NOFULLWIDTHCHARBREAK or DT_NOPREFIX or DT_WORDBREAK);
  Canvas.FillRect(Rect(0, ImageHeight, Width, Height));
end;

procedure TPBSSRow.RequestAlign;
begin
  {eat inherited}
end;

procedure TPBSSRow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TPBSSRow.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
  inherited;
  if (FGraphic <> nil) and not FGraphic.Empty then
    Message.WindowPos.cy := ImageHeight(Message.WindowPos.cx) + Padding.Bottom;
end;

{ TPBSSView }

procedure TPBSSView.AddRow(const FileName: TFileName);
var
  Row: TPBSSRow;
begin
  Row := TPBSSRow.Create(Self);
  Row.Align := alTop;
  Row.Padding.Bottom := 2;
  Row.Parent := Self;
end;

constructor TPBSSView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  VertScrollBar.Tracking := True;
end;

procedure TPBSSView.FillRow(Index: Integer; ImageStream: TMemoryStream);
begin
  Rows[Index].LoadImageFromStream(ImageStream);
end;

function TPBSSView.GetRow(Index: Integer): TPBSSRow;
begin
  Result := TPBSSRow(Controls[Index]);
end;

procedure TPBSSView.PaintWindow(DC: HDC);
begin
  {eat inherited}
end;

procedure TPBSSView.WMEnterSizeMove(var Message: TMessage);
begin
  if not AlignDisabled then
    DisableAlign;
  inherited;
end;

procedure TPBSSView.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  DC: HDC;
begin
  DC := GetDC(Handle);
  try
    FillRect(DC, Rect(0, VertScrollBar.Range, Width, Height), Brush.Handle);
  finally
    ReleaseDC(Handle, DC);
  end;
  Message.Result := 1;
end;

procedure TPBSSView.WMExitSizeMove(var Message: TMessage);
begin
  inherited;
  if AlignDisabled then
    EnableAlign;
end;

end.

如果仍表现不佳，则有多个其他改进方案。

更新：

• 通过覆盖/拦截WM_ERASEBKGND（以及拦截版本< XE2的PaintWindow），消除闪烁，
• 通过使用DisableAlign和EnableAlign来提高性能。

- NGLN

---

我今天晚些时候会试一下。在可预见的未来，只会有一个滚动框组件，因此数组使用不会重叠。但是谁知道它会发展成什么样子。我很感激你在这个示例上的工作，这可能会被接受为答案。我通常会等待24小时才这样做。 - Brian Holloway

到目前为止，我遇到了一个问题。事后设置行高度。目前，随着图像扩展到其完整高度，它们要么重叠在彼此之上，要么只是进入每一行。无论哪种方式，在调整大小事件中设置高度都会导致访问冲突。不确定自己失误的地方在哪里。 - Brian Holloway

@BrianHolloway 我不知道这在你的系统上看起来如何 - 我总是会遇到一些残留的闪烁。在这种情况下，我通过覆盖有问题的控件上的 CreateParams 并将 WS_CLIPCHILDREN 添加到窗口样式来处理它 - 这可以防止父控件尝试绘制与其子控件相同的区域。我已经编辑了答案以包括这个。 - J...

@J... TScrollBox默认具有WS_CLIPCHILDREN，但我似乎通过设置ControlStyle将其删除了。已更改并撤消。感谢关注！ - NGLN

我会仔细研究一下。开发系统使用的是GTX 570，不确定它对2D性能的影响是否高于普通系统。但是，我会将所有东西都在我的笔记本电脑上运行，该笔记本电脑配备了Core2Duo和9800M GS，作为旧但功能强大的系统的基准，它几乎无法播放1080P视频。 - Brian Holloway

Answer 2

我不知道这是否会有明显的差异，但是不要分别设置PBSSRow[I].Width和PBSSRow[I].Top，而是调用PBSSRow[I].SetBounds只需一次即可。这将为该子组件节省一个Resize事件。

- Uwe Raabe

---

我很感激这个提示。我有时会错过一些显而易见的简单优化。有时它们会在之后的代码中实现，有时则不会。 - Brian Holloway