如何在 Delphi 中加速 UI 渲染

Question

我使用 TScrollBox 作为列表，使用 TFrame 作为项目，我将在运行时生成帧。我使用的框架包含一个 3.6KB 的 SVG 图像和一些标签和编辑框。作为测试，我在 FormShow 中生成了包含 1000 个项目的列表，如下所示：

var
  i: Integer;
begin
  for i := 1 to 1000 do
    with TFrameCDG.Create(Self) do
    begin
      Name := 'cdgFrame' + IntToStr(i);
      Parent := sbScrollBoxLeft;
    end;
end;

请注意，我已将框架的 Align 属性设置为 alTop 并使用事件 OnExit、OnEnter、OnClick 等控制背景颜色，以使列表看起来更好。

问题是表单在 38 秒后加载，在 12 秒后调整大小（最大化），并且滚动非常频繁。我的 cpu 是 i7-4790，gpu Radeon R7 430、16GB RAM，我使用的是 Windows 11 和 Delphi 10 Seattle。

我所做的有什么问题？

我删除了 SVG-Image，加载需要 29 秒。我尝试了 DoubleBuffered，但并没有像我想的那样有帮助。

此列表将不会超过 50 个项目，但它非常沉重且缓慢。我怎样才能使这种图形用户界面像（或接近）c# 中的 wpf 可以做什么一样流畅？

我创建了一个新项目，这是一个最简单的例子：

program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Frame2: TFrame};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit2;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to 1000 do
    with TFrame2.Create(Self) do
    begin
      Name := 'Framea' + IntToStr(i);
      Parent := ScrollBox1;
    end;
end;

end.




unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls;

type
  TFrame2 = class(TFrame)
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Edit1: TEdit;
    Bevel1: TBevel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    Button1: TButton;
    procedure FrameClick(Sender: TObject);
    procedure FrameEnter(Sender: TObject);
    procedure FrameExit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{$R *.dfm}

procedure TFrame2.FrameClick(Sender: TObject);
begin
  Self.SetFocus;
end;

procedure TFrame2.FrameEnter(Sender: TObject);
begin
  Color := clBlue;
end;

procedure TFrame2.FrameExit(Sender: TObject);
begin
  Color := clTeal;
end;

end.




object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 660
  ClientWidth = 1333
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 1333
    Height = 660
    HorzScrollBar.Visible = False
    VertScrollBar.Smooth = True
    VertScrollBar.Tracking = True
    Align = alClient
    TabOrder = 0
  end
end




object Frame2: TFrame2
  Left = 0
  Top = 0
  Width = 451
  Height = 117
  Align = alTop
  Color = clTeal
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -19
  Font.Name = 'Segoe UI'
  Font.Style = []
  ParentBackground = False
  ParentColor = False
  ParentFont = False
  TabOrder = 0
  OnClick = FrameClick
  OnEnter = FrameEnter
  OnExit = FrameExit
  DesignSize = (
    451
    117)
  object Label1: TLabel
    Left = 24
    Top = 16
    Width = 55
    Height = 25
    Caption = 'Label1'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWhite
    Font.Height = -19
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
  end
  object Bevel1: TBevel
    Left = 0
    Top = 0
    Width = 451
    Height = 17
    Align = alTop
    Shape = bsTopLine
    ExplicitLeft = -44
    ExplicitTop = 24
  end
  object Label2: TLabel
    Left = 131
    Top = 16
    Width = 55
    Height = 25
    Caption = 'Label1'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWhite
    Font.Height = -19
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
  end
  object Label3: TLabel
    Left = 238
    Top = 16
    Width = 55
    Height = 25
    Caption = 'Label1'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWhite
    Font.Height = -19
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
  end
  object ProgressBar1: TProgressBar
    Left = 352
    Top = 73
    Width = 77
    Height = 21
    Anchors = [akLeft, akRight, akBottom]
    TabOrder = 0
  end
  object Edit1: TEdit
    Left = 24
    Top = 55
    Width = 101
    Height = 38
    BevelInner = bvNone
    BevelOuter = bvNone
    BorderStyle = bsNone
    Color = 11184810
    Ctl3D = True
    ParentCtl3D = False
    TabOrder = 1
    Text = 'Edit1'
  end
  object Edit2: TEdit
    Left = 131
    Top = 55
    Width = 101
    Height = 38
    BevelInner = bvNone
    BevelOuter = bvNone
    BorderStyle = bsNone
    Color = 11184810
    Ctl3D = True
    ParentCtl3D = False
    TabOrder = 2
    Text = 'Edit1'
  end
  object Edit3: TEdit
    Left = 238
    Top = 55
    Width = 101
    Height = 38
    BevelInner = bvNone
    BevelOuter = bvNone
    BorderStyle = bsNone
    Color = 11184810
    Ctl3D = True
    ParentCtl3D = False
    TabOrder = 3
    Text = 'Edit1'
  end
  object Button1: TButton
    Left = 354
    Top = 36
    Width = 75
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Button1'
    TabOrder = 4
  end
end

Answer 1

尝试使用 TPanel 作为容器而不是 TFrame。 在添加面板之前调用ScrollBox.DisableAlign一次，在添加最后一个面板之后调用ScrollBox.EnableAlign。 我认为如果面板总高度达到 32768 像素，您可能会有一些有趣的行为。这将需要一种替代方法。