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

时间：2013-05-15 11:44:17

标签： delphi

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

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

屏幕截图：

enter image description here

大约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.

2 个答案:

答案 0 :(得分：11)

一些提示：

  • 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.

Screen shot

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

更新

  • 通过覆盖/拦截WM_ERASEBKGND（以及拦截PaintWindow版本＆lt; XE2）消除了闪烁，
  • 使用DisableAlign和EnableAlign来提高效果。

答案 1 :(得分：2)

我不知道这是否会产生重大影响，而是分别设置PBSSRow [I] .Width和PBSSRow [I] .Top，而是调用PBSSRow [I] .SetBounds。这将为您保存一个SubComponent的Resize事件。

相关问题
最新问题