Я использую 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
Это VCL, 6 меток и 2 поля редактирования. Я бы также добавил кнопку и индикатор выполнения.
Происходит что-то еще. VCL должен хорошо с этим справляться. Пожалуйста, предоставьте минимальный воспроизводимый пример особенно если нет изображения.
Да. 8 элементов управления — это очень мало. В общем, создание 8 элементов управления должно происходить сразу. Человек не должен быть в состоянии обнаружить задержку. (Предполагая стандартные элементы управления VCL.)
Я создал новый проект и отредактировал пост. пожалуйста, взгляните. Заранее спасибо.
Ваша основная проблема в том, что вы создаете 1001 элемент управления TFrame
за один раз, хотя вы можете показать только что-то вроде макс. 10 в любое время.
Как ускорить? Не создавайте больше контроля, чем видно на экране. Храните данные в структуре данных, а не в оконных элементах управления. Затем рисуйте то, что видно, не более. Взгляните на TVirtualTreeView, который, вероятно, можно настроить для создания списка вместо дерева.
1001 был просто для теста, чтобы узнать, насколько быстр Delphi, потому что он плохо работал для 50 TFrame, и я решил проверить его скорость с 1001 объектом.
Попробуйте использовать TPanel
в качестве контейнера вместо TFrame
.
Вызовите ScrollBox.DisableAlign
один раз перед добавлением панелей и ScrollBox.EnableAlign
после добавления последней панели.
Я думаю, у вас может быть какое-то забавное поведение, если общая высота панелей достигает 32768 пикселей. Это потребует альтернативного подхода.
насколько я помню, есть также дополнительное свойство, блокирующее перерисовку. кто-нибудь знает? я не могу вспомнить в настоящее время.
Если используется Delphi 11, вы можете заблокировать/разблокировать рисование с помощью ScrollBox.LockDrawing/UnlockDrawing. Или, альтернативно, SendMessage(ScrollBox.Handle, WM_SETREDRAW, Ord(False), 0) и SendMessage(WindowHandle, WM_SETREDRAW, Ord(True), 0)
Прочитав полезные комментарии, я решил изменить свой код, чтобы получить лучшее (не самое лучшее) решение. Я привожу это здесь, потому что, возможно, это полезно для других. Логика в том, что он создает фреймы без установки их родителей (в памяти, а не на форме) и очень быстро. Затем он установит родительский элемент возможных видимых фреймов на 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, если бы у меня было время.
Сколько ярлыков и полей редактирования? Это FMX или VCL?