Как ускорить рендеринг пользовательского интерфейса в Delphi

Я использую TScrollBox в качестве списка и TFrame в качестве элементов, и я буду генерировать кадры во время выполнения. Кадр, который я использую, состоит из SVG-изображения размером 3,6 КБ и нескольких этикеток и полей редактирования. В качестве теста я сгенерировал список из 1000 элементов в FormShow следующим образом:

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 секунд (Развернуть до максимума) и очень сильно прокручивается. Мой процессор i7-4790, графический процессор Radeon R7 430, 16 ГБ ОЗУ, и я использую Windows 11 и Delphi 10 Seattle.

Что не так с тем, что я сделал?

Я удалил SVG-изображение, и загрузка заняла 29 секунд. Я попробовал DoubleBuffered, и это не помогло, как я думал.

В этом списке будет не более 50 элементов, но он очень тяжелый и медленный. Как я могу ускорить такой графический интерфейс, чтобы он был гладким, как (или близко к тому), что может сделать 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

Сколько ярлыков и полей редактирования? Это FMX или VCL?

Dalija Prasnikar 06.12.2022 11:18

Это VCL, 6 меток и 2 поля редактирования. Я бы также добавил кнопку и индикатор выполнения.

Mahan 06.12.2022 12:35

Происходит что-то еще. VCL должен хорошо с этим справляться. Пожалуйста, предоставьте минимальный воспроизводимый пример особенно если нет изображения.

Dalija Prasnikar 06.12.2022 12:37

Да. 8 элементов управления — это очень мало. В общем, создание 8 элементов управления должно происходить сразу. Человек не должен быть в состоянии обнаружить задержку. (Предполагая стандартные элементы управления VCL.)

Andreas Rejbrand 06.12.2022 12:39

Я создал новый проект и отредактировал пост. пожалуйста, взгляните. Заранее спасибо.

Mahan 06.12.2022 13:04

Ваша основная проблема в том, что вы создаете 1001 элемент управления TFrame за один раз, хотя вы можете показать только что-то вроде макс. 10 в любое время.

Tom Brunberg 06.12.2022 13:19

Как ускорить? Не создавайте больше контроля, чем видно на экране. Храните данные в структуре данных, а не в оконных элементах управления. Затем рисуйте то, что видно, не более. Взгляните на TVirtualTreeView, который, вероятно, можно настроить для создания списка вместо дерева.

fpiette 06.12.2022 13:38

1001 был просто для теста, чтобы узнать, насколько быстр Delphi, потому что он плохо работал для 50 TFrame, и я решил проверить его скорость с 1001 объектом.

Mahan 07.12.2022 17:33
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
8
254
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Попробуйте использовать TPanel в качестве контейнера вместо TFrame. Вызовите ScrollBox.DisableAlign один раз перед добавлением панелей и ScrollBox.EnableAlign после добавления последней панели. Я думаю, у вас может быть какое-то забавное поведение, если общая высота панелей достигает 32768 пикселей. Это потребует альтернативного подхода.

насколько я помню, есть также дополнительное свойство, блокирующее перерисовку. кто-нибудь знает? я не могу вспомнить в настоящее время.

Quelltextknecht 10.12.2022 15:15

Если используется Delphi 11, вы можете заблокировать/разблокировать рисование с помощью ScrollBox.LockDrawing/UnlockDrawing. Или, альтернативно, SendMessage(ScrollBox.Handle, WM_SETREDRAW, Ord(False), 0) и SendMessage(WindowHandle, WM_SETREDRAW, Ord(True), 0)

dwrbudr 12.12.2022 14:35
Ответ принят как подходящий

Прочитав полезные комментарии, я решил изменить свой код, чтобы получить лучшее (не самое лучшее) решение. Я привожу это здесь, потому что, возможно, это полезно для других. Логика в том, что он создает фреймы без установки их родителей (в памяти, а не на форме) и очень быстро. Затем он установит родительский элемент возможных видимых фреймов на Panel1, а также установит правую верхнюю часть ScrollChange полосы прокрутки.

Кстати, как я упоминал ранее, я пытался создать так много фреймов только потому, что хотел протестировать vcl, однако приведенный ниже код у меня хорошо работает даже с 1000 фреймами:

...

var
  Form1: TForm1;
  InvisibleFrames: TArray<TFrame2>;
  NumberOfVisibleFrames: Integer;
  NumberOfInvisibleFrames: Integer;

const
  TrackingPrecision = 20;

...

procedure TForm1.btnCreateClick(Sender: TObject);
var
  i: Integer;
begin
  NumberOfInvisibleFrames := 1000;
  SetLength(InvisibleFrames, NumberOfInvisibleFrames * SizeOf(TFrame2));
  for i := 0 to NumberOfInvisibleFrames - 1 do
  begin
    InvisibleFrames[i] := TFrame2.Create(Self);
    InvisibleFrames[i].Name := '';
    InvisibleFrames[i].Label1.Caption := 'Frame: ' + IntToStr(i + 1);
  end;
  Panel1.OnResize := Panel1Resize;
  Panel1Resize(Sender);
end;

procedure TForm1.Panel1Resize(Sender: TObject);
begin
  NumberOfVisibleFrames := Panel1.Height div InvisibleFrames[0].Height + 1;
  ScrollBar1.Min := 0;
  ScrollBar1.Max := Max((NumberOfInvisibleFrames - NumberOfVisibleFrames) * TrackingPrecision, 0);
  ScrollBar1.Enabled := ScrollBar1.Max > 0;
  ScrollBar1.LargeChange := TrackingPrecision * (NumberOfVisibleFrames - 1);
  ScrollBar1.SmallChange := TrackingPrecision;
  ScrollBar1Change(Sender);
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  i: Integer;
  n: Integer;
begin
  SendMessage(Panel1.Handle, WM_SETREDRAW, WPARAM(False), 0);
  try
    Panel1.Hide;
    for i := 0 to NumberOfInvisibleFrames - 1 do
    begin
      with InvisibleFrames[i] do
      begin
        Parent := nil;
      end;
    end;
    n := ScrollBar1.Position div TrackingPrecision;
    for i := n to n + NumberOfVisibleFrames do
    begin
      if Assigned(InvisibleFrames[i]) then
        with InvisibleFrames[i] do
        begin
          Parent := Panel1;
          Name := '';
          Left := 0;
          Width := Panel1.ClientWidth;
          if ScrollBar1.Enabled then
            Top := Ceil((i - ScrollBar1.Position / TrackingPrecision) * Height +
             (ScrollBar1.Position / ScrollBar1.Max) * (Panel1.Height mod Height - Height))
          else
            Top := i * Height;
        end;
    end;
  finally
    SendMessage(Panel1.Handle, WM_SETREDRAW, WPARAM(True), 0);
    Panel1.Show;
  end;
end;

Это должно потребовать некоторых модификаций, которые я внесу в свой реальный проект, таких как улучшенная проверка ошибок, управление элементами или освобождение памяти и так далее.

Или, может быть, я бы сделал из него компонент, вызывающий TFrameListBox, если бы у меня было время.

Другие вопросы по теме