在表单调整大小时调整大量组件的性能问题

我觉得到目前为止我的失败在于搜索词，因为这方面的信息必须非常普遍。基本上，我正在寻找在调整表单大小时对多个组件执行调整大小时的通用解决方案和最佳实践。

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

截屏：

大约 16 行表现良好。我的目标是接近 32 行，这非常不稳定，并且可以将核心固定在 100% 使用率。

我努力了：

• 添加了一项检查，以防止在前一个调整大小尚未完成时开始新的调整大小。如果发生的话它就会回答，而且有时确实会发生。
• 我尝试阻止它调整大小的频率超过每 30 毫秒，这样可以每秒绘制 30 帧。结果好坏参半。
• 将行基础组件从 TPanel 更改为 TWinControl。不确定使用面板是否会降低性能，但这是一个老习惯。
• 有和没有双缓冲。

我希望允许在调整大小期间进行行大小调整，作为图像在行中的大小的预览。这就消除了一种明显的解决方案，而这种解决方案在某些应用中是可以接受的损失。

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

组件的完整单元代码：

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.

一些提示：

• TWinControl已经是一个容器，您不需要在其中添加另一个面板来添加控件
• 您不需要TImage组件来查看图形，也可以使用TPaintBox，或者如下面我的示例控件所示，TCustomControl,
• 由于所有其他面板都无法识别（边框和斜角被禁用），因此将它们完全松开并放置TMemo直接在行控件上，
• SetSubComponent仅供设计时使用。你不需要它。也不Register有关此事的程序。
• 将全局行数组放入类定义中，否则多个TPBSSView控件将使用相同的数组！
• TWinControl已经跟踪其所有子控件，因此您无论如何都不需要该数组，请参阅下面的示例，
• 利用Align属性可以让您免于手动重新调整，
• 如果备忘录控件仅用于显示文本，则将其删除并自己绘制文本。

初学者可以试试这个：

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.

如果这仍然表现不佳，那么还有多种其他可能的增强功能。

Update:

• 通过覆盖/拦截消除闪烁WM_ERASEBKGND（并拦截PaintWindow对于版本
• 通过使用更好的性能DisableAlign http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Controls.TWinControl.DisableAlign and EnableAlign.