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

后端 未结 2 1644
走了就别回头了
走了就别回头了 2021-02-06 02:38

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 resi

相关标签:
2条回答
  • 2021-02-06 03:15

    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.

    0 讨论(0)
  • 2021-02-06 03:28

    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.
    

    Screen shot

    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.
    0 讨论(0)
提交回复
热议问题