delphi - フォームのサイズ変更時に大量のコンポーネントのサイズを変更すると、パフォーマンスの問題が発生する

Question

これに関する情報はかなり一般的でなければならないため、これまでの私の失敗は検索用語にあると感じています。基本的に、フォームのサイズ変更中に複数のコンポーネントのサイズ変更を実行する際の一般的な解決策とベストプラクティスを探しています。

に基づくコンポーネントを含むフォームがありますTScrollBox。ScrollBox には、実行時に動的に追加される行が含まれます。それらは基本的にサブコンポーネントです。それぞれ、左が画像、右がメモです。高さは、画像の幅と縦横比に基づいて設定されます。スクロールボックスのサイズが変更されると、ループによって行の幅が設定され、行自体の内部サイズ変更がトリガーされます。高さが変更された場合、ループは相対的な上部位置も設定します。

スクリーンショット:

約 16 行で問題なく動作します。私の目標は 32 行に近づくことです。

私が試してみました：

前のサイズ変更がまだ完了していない間に新しいサイズ変更が開始されないようにするチェックを追加しました。場合によっては発生する場合があると回答しました。
毎秒 30 フレームの描画を可能にする 30 ミリ秒ごとよりも頻繁にサイズ変更しないようにしました。混合結果。
行ベースコンポーネントを TPanel から TWinControl に変更しました。パネルを使用してパフォーマンスが低下するかどうかはわかりませんが、これは古い習慣です。
ダブルバッファリングありとなし。

行内の画像の大きさのプレビューとして、サイズ変更中に行のサイズ変更を許可したいと思います。これにより、一部のアプリケーションでは許容できる損失であるという明らかな解決策が 1 つなくなります。

現在、行の内部的なサイズ変更コードは完全に動的で、各画像のサイズに基づいています。次に試みることは、基本的に、コレクション内の最大の画像に基づいて、アスペクト比、最大幅/高さを指定することです。これにより、行ごとの計算量が削減されます。しかし、問題はサイズ変更イベントとループ自体にあるようです?

コンポーネントの完全なユニットコード:

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.

delphi - フォームのサイズ変更時に大量のコンポーネントのサイズを変更すると、パフォーマンスの問題が発生する

2 に答える 2

Related

Reference