unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, System.Generics.Collections, VirtualTrees,
Vcl.StdCtrls;
type
TMyDataClass =
class(TObject)
ID: Integer;
Name:
string;
HasChildren: Boolean;
NodeColor: TColor;
end;
PMyDataClass = ^TMyDataClass;
TMyDataClasses = TObjectList<TMyDataClass>;
TForm1 =
class(TForm)
vst1: TVirtualStringTree;
btnCreate1MioObjects: TButton;
btnCreate100TObjects: TButton;
lblObjectDuration: TLabel;
lblNodeDuration: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure vst1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText:
string);
procedure vst1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;
var ChildCount: Cardinal);
procedure vst1PaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
procedure btnCreate100TObjectsClick(Sender: TObject);
procedure btnCreate1MioObjectsClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{Private-Deklarationen}
FMyDataClasses: TMyDataClasses;
procedure CreateSomeObjects(
const ACount: Integer);
public
{Public-Deklarationen}
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnCreate1MioObjectsClick(Sender: TObject);
begin
CreateSomeObjects(1000000);
end;
procedure TForm1.btnCreate100TObjectsClick(Sender: TObject);
begin
CreateSomeObjects(2);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FMyDataClasses.Delete(0);
// LÖSCHE DEN ERSTEN EINTRAG - SCHLÄGT FEHL
vst1.RootNodeCount := FMyDataClasses.Count;
end;
procedure TForm1.CreateSomeObjects(
const ACount: Integer);
var
i: Integer;
Data: TMyDataClass;
Start: Cardinal;
begin
Start := GetTickCount;
vst1.Clear;
FMyDataClasses.Clear;
for i := 0
to ACount - 1
do
begin
Data := TMyDataClass.Create;
Data.ID := i + 1;
Data.
Name := '
DataObject ' + IntToStr(i + 1);
Data.HasChildren := True;
Data.NodeColor := Random($FFFFFF);
FMyDataClasses.Add(Data);
// Hier die erzeugten Objekte zwischenspeichern
end;
lblObjectDuration.Caption := '
Dauer Object Erstellung: ' + IntToStr(GetTickCount - Start) + '
ms';
Start := GetTickCount;
vst1.RootNodeCount := ACount;
lblNodeDuration.Caption := '
Dauer Node Erstellung: ' + IntToStr(GetTickCount - Start) + '
ms';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
FMyDataClasses := TMyDataClasses.Create(True);
// Owns Objects auf true, damit beim Freigeben der Liste auch die darin enthaltenen Objekte automatisch freigegeben werden
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMyDataClasses.Free;
end;
procedure TForm1.vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText:
string);
var
NodeData: TMyDataClass;
begin
if (vst1.GetNodeLevel(Node) = 0)
then
begin
NodeData := Node.GetData<TMyDataClass>;
CellText := NodeData.
Name;
end
else
CellText := '
SubItem ' + IntToStr(Node^.
Index + 1);
end;
procedure TForm1.vst1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;
var ChildCount: Cardinal);
begin
ChildCount := 2;
end;
procedure TForm1.vst1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
NodeData: TMyDataClass;
begin
Node.SetData<TMyDataClass>(FMyDataClasses[Node.
Index]);
NodeData := Node.GetData<TMyDataClass>;
if (vst1.GetNodeLevel(Node) = 0)
then
begin // Nur auf dem ersten NodeLevel Children zulassen
if (NodeData.HasChildren)
then
begin
Include(InitialStates, ivsHasChildren);
// Hier wird im Status der Node vermerkt, dass die Node mindestens 1 ChildNode hat und das + Symbol angezeigt werden soll
end;
end;
end;
procedure TForm1.vst1PaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
var
NodeData: TMyDataClass;
begin
NodeData := Node.GetData<TMyDataClass>;
if (vst1.GetNodeLevel(Node) = 0)
then
begin
TargetCanvas.Font.Color := NodeData.NodeColor;
end;
end;
end.