You've already forked lazarus-ccr
* Create branches and trunk directories
* Move files to trunk git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1035 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
549
components/virtualtreeview-new/trunk/demos/dataarray/Main.pas
Normal file
549
components/virtualtreeview-new/trunk/demos/dataarray/Main.pas
Normal file
@ -0,0 +1,549 @@
|
||||
unit Main;
|
||||
|
||||
{$MODE Delphi}
|
||||
|
||||
{
|
||||
|
||||
How to use TVirtualTree with your data
|
||||
already stored somewhere (array or memory)?
|
||||
|
||||
You need to solve cross-linked problem between
|
||||
your data and TVirtualTree record node and avoid
|
||||
doubling data in TVirtualTree record node?
|
||||
|
||||
This example shows one way of what you need
|
||||
to accomplish.
|
||||
|
||||
Additionally, here you can find how to
|
||||
conditionally color you cell's background
|
||||
and font foreground and how to sort VST by
|
||||
clicking on columns.
|
||||
|
||||
Also shows which property are initially needed
|
||||
to be set for comfortable using.
|
||||
|
||||
This is my humble contribution for
|
||||
users who start to use Mike Lischke's
|
||||
TVirtualTree component.
|
||||
|
||||
Thank you Mike for such a beautiful component.
|
||||
|
||||
The initial developer of this code is Sasa Zeman.
|
||||
Mailto: public@szutils.net or sasaz72@mail.ru
|
||||
Web site: www.szutils.net
|
||||
|
||||
Created: 7 Jun 2004
|
||||
|
||||
This example is distributed "AS IS", WITHOUT
|
||||
WARRANTY OF ANY KIND, either express or implied.
|
||||
|
||||
You use it at your own risk!
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, VirtualTrees, StdCtrls, LResources, Buttons;
|
||||
|
||||
type
|
||||
|
||||
{ Problem description:
|
||||
|
||||
VST is designed to use your own declared record data
|
||||
in his nodes, which are automatically created and
|
||||
destroying. That is beautiful, easy and fast.
|
||||
|
||||
But, what if you have your data already formated somewhere
|
||||
in array or memory and your algorithms are already optimized
|
||||
to use it on that way? How to use VST with them?
|
||||
|
||||
Since VST node can consist any data record, that can be only
|
||||
a index or pointer to your real data. The only problem left is
|
||||
that actions in your data must affect on corespondent VST node.
|
||||
One way is to sequentially go through the VST and find the node
|
||||
which consists equal index index, which rapidly decrease
|
||||
performance...
|
||||
|
||||
To handle this situation the most efficiently, your array data
|
||||
record must additionally consist the pointer to the VST
|
||||
corespondent node...
|
||||
}
|
||||
|
||||
TMyRecord = record
|
||||
// Point directly from my record to corespondent VST Node
|
||||
// That is useful if your action inside
|
||||
// the record involve on your VTS node,
|
||||
// for example, if disabling mean deletion
|
||||
// of corespondent node, etc.
|
||||
|
||||
NodePointer: PVirtualNode;
|
||||
Active: Boolean;
|
||||
MyText: UTF8String;
|
||||
RNDNumber: integer;
|
||||
end;
|
||||
|
||||
rTreeData = record
|
||||
//This point to my index into my array
|
||||
//Instead of index, here you can
|
||||
//store the pointer to your data.
|
||||
//That depend of what is your intentions
|
||||
//and your data structure
|
||||
|
||||
IndexInMyData: integer;
|
||||
|
||||
end;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
btnDelete: TButton;
|
||||
Edit1: TEdit;
|
||||
btnCleanAll: TButton;
|
||||
Edit2: TEdit;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
MyTree: TVirtualStringTree;
|
||||
procedure MyTreeBeforeCellPaint(Sender: TBaseVirtualTree;
|
||||
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
|
||||
procedure MyTreeGetText(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: UTF8String);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure MyTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||||
procedure MyTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
procedure btnDeleteClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure MyTreePaintText(Sender: TBaseVirtualTree;
|
||||
const TargetCanvas: TCanvas; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType);
|
||||
procedure MyTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||
procedure MyTreeFocusChanged(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure btnCleanAllClick(Sender: TObject);
|
||||
procedure Edit2Change(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
MyArrayData: array of TMyRecord;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
|
||||
procedure TForm1.MyTreeGetText(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: UTF8String);
|
||||
var
|
||||
Data: ^rTreeData;
|
||||
|
||||
begin
|
||||
// To get Node Data
|
||||
Data := Sender.GetNodeData(Node);
|
||||
|
||||
with MyArrayData[Data.IndexInMyData] do
|
||||
case Column of
|
||||
0: CellText := MyText;
|
||||
1:
|
||||
begin
|
||||
CellText := format('Stored %p Actual %p',
|
||||
[NodePointer,Node]);
|
||||
end;
|
||||
2: CellText := inttostr(RNDNumber);
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
var
|
||||
Node: PVirtualNode;
|
||||
Data: ^rTreeData;
|
||||
|
||||
i,Idx: integer;
|
||||
Timer: cardinal;
|
||||
begin
|
||||
|
||||
// Add 100000 new records and corespondent VST nodes
|
||||
|
||||
Timer := GetTickCount;
|
||||
|
||||
MyTree.BeginUpdate;
|
||||
|
||||
Idx := length(MyArrayData);
|
||||
SetLength(MyArrayData, length(MyArrayData)+100000);
|
||||
for i := 1 to 100000 do
|
||||
begin
|
||||
// Add a node to the root of the Tree
|
||||
Node := MyTree.AddChild(nil);
|
||||
Data := MyTree.GetNodeData(Node);
|
||||
|
||||
//Create link to your data record into VST node
|
||||
Data.IndexInMyData := Idx;
|
||||
|
||||
// Working with your array data
|
||||
with MyArrayData[Data.IndexInMyData] do
|
||||
begin
|
||||
|
||||
//Create link into your data record to VST node
|
||||
NodePointer := Node;
|
||||
|
||||
RNDNumber := round(Random(1 shl 16));
|
||||
MyText := format(' Index %d',[Data.IndexInMyData])
|
||||
|
||||
end;
|
||||
inc(Idx)
|
||||
end;
|
||||
MyTree.EndUpdate;
|
||||
|
||||
Timer := GetTickCount-Timer;
|
||||
caption := format('Adding %d ms, Total nodes %d, Total arrays %d',[Timer, MyTree.RootNodeCount,length(MyArrayData)] );
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||||
var
|
||||
n1,n2: ^rTreeData;
|
||||
d1,d2: ^TMyRecord;
|
||||
begin
|
||||
n1 := MyTree.GetNodeData(Node1);
|
||||
n2 := MyTree.GetNodeData(Node2);
|
||||
|
||||
// Get the pointers where your data are
|
||||
// in the array, to speed-up process
|
||||
d1 := @MyArrayData[n1.IndexInMyData];
|
||||
d2 := @MyArrayData[n2.IndexInMyData];
|
||||
|
||||
case Column of
|
||||
0: Result := CompareValue(n1.IndexInMyData,n2.IndexInMyData);
|
||||
1: ;
|
||||
2: Result := CompareValue(
|
||||
d1.RNDNumber,
|
||||
d2.RNDNumber
|
||||
)
|
||||
else
|
||||
Result := 0;
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
Direction : TSortDirection;
|
||||
begin
|
||||
|
||||
// Descending order with pressed Shift, otherwise Ascending
|
||||
// Or you can save Direction or use
|
||||
// MyTree.Header.SortDirection and MyTree.Header.SortColumn
|
||||
// to get automatically Descending/Ascending sorting
|
||||
// by only clicking on header
|
||||
|
||||
if ssShift in Shift
|
||||
then
|
||||
Direction := sdDescending
|
||||
else
|
||||
Direction := sdAscending;
|
||||
|
||||
// Sort all columns except the second
|
||||
if Column<>1 then
|
||||
begin
|
||||
// Set direction image on the sorted column
|
||||
MyTree.Header.SortColumn := Column;
|
||||
|
||||
// Set the right direction image
|
||||
MyTree.Header.SortDirection := Direction;
|
||||
|
||||
// Sorting process
|
||||
MyTree.SortTree(Column, Direction);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.btnDeleteClick(Sender: TObject);
|
||||
var
|
||||
Timer: cardinal;
|
||||
begin
|
||||
|
||||
// Delete all selected nodes
|
||||
|
||||
Timer := GetTickCount;
|
||||
|
||||
MyTree.BeginUpdate;
|
||||
MyTree.DeleteSelectedNodes;
|
||||
MyTree.EndUpdate;
|
||||
|
||||
Timer := GetTickCount-Timer;
|
||||
caption := format('Deleting %d ms, Total nodes %d, Total arrays %d',[Timer, MyTree.RootNodeCount,length(MyArrayData)] );
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
const
|
||||
|
||||
ColumnParams: array[0..2] of
|
||||
record
|
||||
Name: ShortString;
|
||||
Len: integer;
|
||||
Alignment:TAlignment;
|
||||
end =
|
||||
((Name:'Text' ; Len:150 ; Alignment: taLeftJustify),
|
||||
(Name:'Pointers' ; Len:300 ; Alignment: taLeftJustify),
|
||||
(Name:'Random' ; Len:120 ; Alignment: taLeftJustify)
|
||||
);
|
||||
|
||||
var
|
||||
NewColumn: TVirtualTreeColumn;
|
||||
i: integer;
|
||||
begin
|
||||
// Initialize size of node in MyTree
|
||||
// This is the most important to be done before any using of VST,
|
||||
// because that is the only way how VST can allocate needed
|
||||
// space for your node
|
||||
MyTree.NodeDataSize := sizeof(rTreeData);
|
||||
|
||||
// When you add data by yourself,
|
||||
// be sure that there is no node in tree
|
||||
MyTree.RootNodeCount := 0;
|
||||
|
||||
// If you want to manually set necessary events or parameters,
|
||||
// without Object Inspector. That will help in case
|
||||
// you have accidentally deleted your component
|
||||
// and you do not have a time to work with Object Inspector
|
||||
// and rearrange the events or other properties
|
||||
|
||||
// First follows the properties you may set it here or with
|
||||
// Object Inspector to be more suitable for standard using
|
||||
|
||||
// Shows the header columns
|
||||
MyTree.Header.Options :=
|
||||
MyTree.Header.Options + [hoVisible];
|
||||
|
||||
// Shows the header like XP does
|
||||
MyTree.Header.Style := hsXPStyle;
|
||||
|
||||
// Allows multi selection of nodes
|
||||
MyTree.TreeOptions.SelectionOptions :=
|
||||
MyTree.TreeOptions.SelectionOptions +[toMultiSelect];
|
||||
|
||||
// Allows that automatic multi selection is possible
|
||||
// beyond the screen
|
||||
MyTree.TreeOptions.AutoOptions :=
|
||||
MyTree.TreeOptions.AutoOptions + [toAutoScroll];
|
||||
|
||||
// If delay of 1000 ms is too slow during
|
||||
// automatic multi selection
|
||||
MyTree.AutoScrollDelay := 100;
|
||||
|
||||
// Disable automatic deletion of moved data during
|
||||
// Drag&Drop operation
|
||||
MyTree.TreeOptions.AutoOptions :=
|
||||
MyTree.TreeOptions.AutoOptions - [toAutoDeleteMovedNodes];
|
||||
|
||||
// To show the bacground image on VST
|
||||
MyTree.TreeOptions.PaintOptions :=
|
||||
MyTree.TreeOptions.PaintOptions +[toShowBackground];
|
||||
|
||||
// If you do not want to show the tree lines
|
||||
// MyTree.TreeOptions.PaintOptions :=
|
||||
// MyTree.TreeOptions.PaintOptions -[toShowTreeLines];
|
||||
|
||||
// If you do not want to show left margine of the main node
|
||||
// MyTree.TreeOptions.PaintOptions :=
|
||||
// MyTree.TreeOptions.PaintOptions -[toShowRoot];
|
||||
|
||||
// If you want to add your columns manually
|
||||
MyTree.Header.Columns.Clear;
|
||||
|
||||
for i := 0 to length(ColumnParams)-1 do
|
||||
with MyTree.Header, ColumnParams[i] do
|
||||
begin
|
||||
|
||||
NewColumn := Columns.Add;
|
||||
|
||||
NewColumn.Text := Name;
|
||||
NewColumn.Width := Len;
|
||||
NewColumn.Alignment := Alignment;
|
||||
|
||||
end;
|
||||
|
||||
// If you want that the second column
|
||||
// do not respond on clicking
|
||||
MyTree.Header.Columns[1].Options :=
|
||||
MyTree.Header.Columns[1].Options - [coAllowClick];
|
||||
|
||||
|
||||
// Setting used events manually
|
||||
|
||||
MyTree.OnBeforeCellPaint := MyTreeBeforeCellPaint;
|
||||
MyTree.OnCompareNodes := MyTreeCompareNodes;
|
||||
MyTree.OnFocusChanged := MyTreeFocusChanged;
|
||||
MyTree.OnFreeNode := MyTreeFreeNode;
|
||||
MyTree.OnGetText := MyTreeGetText;
|
||||
MyTree.OnHeaderClick := MyTreeHeaderClick;
|
||||
MyTree.OnPaintText := MyTreePaintText;
|
||||
|
||||
// To show headers
|
||||
MyTree.Header.Options :=
|
||||
MyTree.Header.Options + [hoVisible];
|
||||
|
||||
//To show Direction Glyphs
|
||||
MyTree.Header.Options :=
|
||||
MyTree.Header.Options + [hoShowSortGlyphs];
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreeBeforeCellPaint(Sender: TBaseVirtualTree;
|
||||
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
|
||||
begin
|
||||
|
||||
// This is example how to conditionally
|
||||
// color the cell's backgrounds
|
||||
|
||||
// Color cell's background only for
|
||||
// the first three columns with every second nodes
|
||||
if (Column<2) and
|
||||
((Node.Index mod 2)=0)
|
||||
then begin
|
||||
TargetCanvas.Brush.Color := clYellow;
|
||||
TargetCanvas.FillRect(CellRect);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreePaintText(Sender: TBaseVirtualTree;
|
||||
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||
TextType: TVSTTextType);
|
||||
var
|
||||
n1: ^rTreeData;
|
||||
d1: ^TMyRecord;
|
||||
begin
|
||||
|
||||
// This is example how to conditionally
|
||||
// color the cell's font color foregrounds
|
||||
|
||||
if (Column=1) and
|
||||
((Node.Index mod 2)=0)
|
||||
then
|
||||
TargetCanvas.Font.Color := clRed;
|
||||
|
||||
if (Column=2)
|
||||
then begin
|
||||
n1 := MyTree.GetNodeData(Node);
|
||||
d1 := @MyArrayData[n1.IndexInMyData];
|
||||
|
||||
// Coloring cell's data depending of your data
|
||||
if (d1.RNDNumber mod 2)=0
|
||||
then begin
|
||||
TargetCanvas.Font.Color := clBlue;
|
||||
TargetCanvas.Font.Style := [fsBold];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreeFreeNode(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode);
|
||||
var
|
||||
n1: ^rTreeData;
|
||||
d1: ^TMyRecord;
|
||||
begin
|
||||
|
||||
// Action when you delete the VST node
|
||||
|
||||
if Node <> nil then
|
||||
begin
|
||||
n1 := MyTree.GetNodeData(Node);
|
||||
d1 := @MyArrayData[n1.IndexInMyData];
|
||||
|
||||
// Deactive record in array
|
||||
d1.Active := false;
|
||||
|
||||
// Detach pointer to this node in your data
|
||||
d1.NodePointer := nil
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.MyTreeFocusChanged(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex);
|
||||
var
|
||||
n1: ^rTreeData;
|
||||
d1: ^TMyRecord;
|
||||
begin
|
||||
// Always be sure that Node exist before you
|
||||
// delete VST node and use OnFocusChanged even
|
||||
// in your code - they will be always triggered
|
||||
// on node deletion
|
||||
|
||||
if Node<> nil then
|
||||
begin
|
||||
n1 := MyTree.GetNodeData(Node);
|
||||
d1 := @MyArrayData[n1.IndexInMyData];
|
||||
|
||||
// Store MyText from array to TEdit
|
||||
// after focused item was changed
|
||||
Edit1.Text := d1.MyText+', Number '+ IntToStr(d1.RNDNumber)
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
btnCleanAll.Click
|
||||
end;
|
||||
|
||||
procedure TForm1.btnCleanAllClick(Sender: TObject);
|
||||
begin
|
||||
// Fast deletion of all your data and VST nodes
|
||||
|
||||
MyTree.OnFreeNode := nil;
|
||||
|
||||
MyTree.Clear;
|
||||
SetLength(MyArrayData,0);
|
||||
|
||||
MyTree.OnFreeNode := MyTreeFreeNode
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.Edit2Change(Sender: TObject);
|
||||
var
|
||||
Node: PVirtualNode;
|
||||
ind: integer;
|
||||
begin
|
||||
ind := StrToIntDef(Edit2.Text,0);
|
||||
|
||||
if ind<length(MyArrayData) then
|
||||
begin
|
||||
Node := MyArrayData[ind].NodePointer;
|
||||
|
||||
if Node<> nil then
|
||||
begin
|
||||
// Show it at center of VST
|
||||
MyTree.ScrollIntoView(Node,True);
|
||||
|
||||
// Get text from the array
|
||||
Edit1.Text :=
|
||||
MyArrayData[ind].MyText+', Number '+ IntToStr(MyArrayData[ind].RNDNumber)
|
||||
|
||||
end else
|
||||
Edit1.Text := 'Node do not exist!'
|
||||
end
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$i Main.lrs}
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user