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

【问题标题】：Performance issues re-sizing large amount of components on form resize性能问题在表单调整大小时重新调整大量组件的大小
【发布时间】：2013-05-09 23:19:28
【问题描述】：

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

我有一个基于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.

【问题讨论】：

你可以试试 LockWindowUpdate(handle); LockWindowUpdate(0);
@bummi 阅读LockWindowUpdate 的文档。这是经常被滥用的 API 函数之一，与 ProcessMessages 被滥用的情况大致相同。
是的，有人告诉我这是一件坏事。好吧，无论如何添加了 2 个组件的完整单元代码。问题是大卫。这件事的发展在最基本的一步就停止了。我几乎无法从这段代码中删除任何内容。它纯粹是调整大小和加载图像，解析 png 块文本。我目前已经处于概念验证状态。此时它基本上是一个示例程序。我还没有进一步开发它。值得注意的是，那里有一些遗留物，有些东西我一直在来回切换。
在尝试阻止循环中的更新之前，请尝试删除每次迭代处理更新的“ProcessMessages”。
好吧，我会试试那个 Sertac。我添加它是为了帮助它完成某些事情，但正如你所说，它实际上允许线程摆脱它正在做的事情并开始其他事情。 @David 还有一件事值得一提。我做了一个“无代码”的例子，它只不过是对齐的面板。最初的性能问题是普遍的。当您有 100 个组件调整到彼此的大小时，就会出现性能问题。我只能假设可以添加代码来缓解问题，例如不执行不必要的操作。

标签： delphi

【解决方案1】：

一些提示：

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.

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

更新：

通过覆盖/拦截 WM_ERASEBKGND（对于版本 PaintWindow）消除闪烁，
利用DisableAlign 和EnableAlign 获得更好的性能。

【讨论】：

我将在今天晚些时候尝试一下。在可预见的将来，只有一个滚动框组件，因此数组使用不会重叠。然而，谁知道它会演变成什么。感谢您在此示例上所做的工作，这可能会被接受为答案。我通常会等 24 小时再这样做。
这很好。我也经常求助于 Erik Bilsen 的 GDI+ 库——那里有一些不错的功能可以使用。我一直发现，只需在自定义控件上覆盖Paint，即使使用双缓冲和杀死WM_ERASEBKGND，总会有一些剩余的闪烁。尽管如此，这还是比 OP 快得多，而且看起来要好得多。 bilsen.com/gdiplus/index.shtml
到目前为止我有一个问题。事后设置行高。现在，随着图像扩展至完整高度，它们要么相互重叠，要么仅在每一行中。无论哪种方式在调整大小事件中设置高度都会导致访问冲突。不知道我在哪里迷失了。
@BrianHolloway 我不知道这在您的系统上看起来如何 - 我总是以一些残余闪烁告终。在这种情况下，我通过覆盖有问题的控件上的CreateParams 并将WS_CLIPCHILDREN 添加到窗口样式来处理它 - 这可以防止父控件尝试绘制与其子控件相同的区域。我已编辑答案以包含此内容。
@J... 从PaintWindow 继承的吃东西也会减少闪烁，但在 XE2 中，TScrollBox 已经做到了。为以前的版本添加了它。

【解决方案2】：

我不知道这是否会产生显着差异，而是分别设置 PBSSRow[I].Width 和 PBSSRow[I].Top，而是调用 PBSSRow[I].SetBounds。这将为您节省该子组件的一个 Resize 事件。

【讨论】：

我很欣赏这个提示。我对其中一些显而易见的简单优化不满意。有时它们会在以后的代码中实现。有时根本没有。