I use a TScrollBox as a list and a TFrame as the Items and I will generate the frames in runtime. The Frame I'm using consists a 3.6KB SVG-Image and some Lables and EditBoxes. As a test, I generated the list with 1000 items in FormShow like this:
var
i: Integer;
begin
for i := 1 to 1000 do
with TFrameCDG.Create(Self) do
begin
Name := 'cdgFrame' + IntToStr(i);
Parent := sbScrollBoxLeft;
end;
end;
Note that I have set the Align property of the frame to alTop and controlled the background color using the events OnExit, OnEnter, OnClick, etc. to make the list look better.
The problem is that the form loads after 38 seconds, resizes in 12 seconds (Maximize), and scrolls very heavily. My cpu is i7-4790, gpu Radeon R7 430, 16GB RAM and I'm using windows 11 and Delphi 10 Seattle.
What's wrong with what I've done?
I deleted the SVG-Image and it took 29 seconds to load. I tried DoubleBuffered and that did not help as I thought.
This list is going to have no more than 50 Items but it is very heavy and slow. How can I accelerate such graphical UI to be smooth like (or near to) what wpf in c# can do?
I created a new project and hier is a minimal example to look at:
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
Reading the useful comments, I decided to change my code to obtain a better (not the best) solution. I bring it here because maybe it is useful for others. The logic is that it creates the frames without settin their parents (in memory not on the form) and it is very fast. Then it will set the parent of the could-be-visible frames to Panel1 and also set the right top, on the ScrollChange of the ScrollBar.
By the way, as I mentioned before, I tryed to create so many frames just because I wanted to test the vcl, however the code below works for me good even with 1000 frames:
...
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;
It should need some modifications which I will make in my real project, like better error checking, controlling the Items, or releasing the memory and so on.
Or maybe I would make a component from it calling TFrameListBox, if I would have time.