Performance issues re-sizing large amount of components on form resize

Question

I feel my failure so far lies in search terms as information on this has to be pretty common. Basically I am looking for common solutions and best practices when performing resizes on several components while a form is resized.

I have a form with a component that is based upon TScrollBox. The ScrollBox contains rows which are added dynamically at run time. They are basically a subcomponent. Each one has an image on the left and a memo on the right. The height is set based upon the width and aspect ratio of the image. Upon the resize of the scroll box a loop sets the width of the rows triggering the rows own internal resize. The loop also sets the relative top position if the heights have changed.

Screen shot:

Around 16 rows performs fine. My goal is closer to 32 rows which is very choppy and can peg a core at 100% usage.

I have tried:

• Added a check to prevent a new resize starting while the previous has yet to complete. It answered if it occured and it does sometimes.
• I tried preventing it resizing more often than every 30 ms which would allow for 30 frame per second drawing. Mixed results.
• Changed the rows base component from TPanel to TWinControl. Not sure if there is a performance penalty using the Panel but its an old habit.
• With and without double buffering.

I would like to allow row resizing to occur during a resize as a preview to how large the image will be in the row. That eliminates one obvious solution that in some applications is an acceptable loss.

Right now the resize code internally for the row is completely dynamic and based upon the dimensions of each image. Next thing I plan to try is to basically specify the Aspect Ratio, Max Width/Height based on the largest image in the collection. This should reduce the amount of math per row. But it seems like the issues are more the resize event and the loop itself?

Full unit code for the components:

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.

Row Code:

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.

Answer 1

A few tips:

• TWinControl already ís a container, you do not need another panel inside it to add controls
• You do not need an TImage component to view a graphic, that can also with TPaintBox, or as in my example control below, a TCustomControl,
• Since all of your other panels are not recognizable (borders and bevels are disabled), loose them altogether and place the TMemo directly on your row control,
• SetSubComponent is only for design time usage. You do not need it. Nor the Register procedures for that matter.
• Put the global rows array inside your class definition, otherwise multiple TPBSSView controls will use the same array!
• TWinControl already tracks all its child controls, so you won't need the array anyway, see my example below,
• Make use of the Align property to save you from realigning manually,
• If the memo control is just for showing text, then remove it and paint the text yourself.

Try this one for starters:

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.

If this still performs badly, then there are multiple other enhancements possible.

Update:

• Flickering eliminated by overriding/intercepting WM_ERASEBKGND (and intercepting PaintWindow for versions < XE2),
• Better performance by making use of DisableAlign and EnableAlign.

Answer 2

I don't know if this will make a significant difference, but instead setting PBSSRow[I].Width and PBSSRow[I].Top separately, make one call to PBSSRow[I].SetBounds instead. This will save you one Resize event for that SubComponent.