Už jsem několikrát naznačil, že Virtual TreeView považuji za nejlepší open source komponentu (a pravděpodobně i komponentu vůbec) pro Delphi.
Dnes jsem potřeboval udělat specifické řešení: rozklikávací položky, na které se dá kreslit, a které mají variabilní výšku. A napadlo mne použít TVirtualDrawTree.
Pro úplnost: první verze používala TDrawGrid, ale tam je problém s posuvníkem, jelikož je podporován jen posun po buňkách.
Komponenty Virtual TreeView jsou v podstatě dvě komponenty, obě jsou ale následníkem TBaseVirtualTree. Zatím jsem zde popisoval TVirtualStringTree (viz dole tag) - obsahuje podporu pro vykreslování textů - na rozdíl od TVirtualDrawTree, kde musíte kreslit všechno (tedy kromě ikon a čar pro uzel). Ukáži jednoduchý program, který ve stromě v první úrovni vypisuje text a ve druhé úrovni kreslí data, ale které jsou různě vysoké.
Pro jistotu: každý geometrický útvar je různě vysoký, přičemž focus se přizpůsobuje výšce řádku. Všechny geometrické útvary jsou kresleny na TCanvas, tj. je možné kreslit úplně vše. Celé kreslení je virtualizované - tj. při požadavku na kreslení se data vykreslí podle aktualní situace (viz. předchozí články). To umožňuje velmi efektivně měnit prezentaci dat bez změn vlastních dat (zní to komplikovaně, ale znamená to, že data v paměti jsou stále stejná jen se kreslí jak je třeba).
Zdrojové kódy: stáhnout (2K)
Popis na konci programu.
1unit Unit1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, VirtualTrees;
8
9type
10 TForm1 = class(TForm)
11 vt: TVirtualDrawTree;
12 procedure FormCreate(Sender: TObject);
13 procedure vtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
14 procedure vtDrawNode(Sender: TBaseVirtualTree;
15 const PaintInfo: TVTPaintInfo);
16 procedure vtBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
17 Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode;
18 CellRect: TRect; var ContentRect: TRect);
19 private
20
21 public
22
23 end;
24
25 TItemType = (itRectangle, itOval, itTriangle);
26
27 PTreeItem=^TTreeItem;
28 TTreeItem = Record
29 item: TItemType;
30 end;
31
32var
33 Form1: TForm1;
34
35implementation
36
37
38
39procedure TForm1.FormCreate(Sender: TObject);
40 procedure mAddItem(DrawItem: TItemType);
41 var
42 pNode: PVirtualNode;
43 pData: PTreeItem;
44 begin
45
46 vt.ChildCount[vt.RootNode] := vt.ChildCount[vt.RootNode] + 1;
47 vt.ValidateNode(vt.RootNode, False);
48
49 pNode := vt.RootNode.LastChild;
50 pData := PTreeItem(vt.GetNodeData(pNode));
51 pData^.item := DrawItem;
52 vt.NodeHeight[pNode] := 20;
53
54
55 vt.ChildCount[pNode] := 1;
56 vt.ValidateNode(pNode, True);
57 pData := PTreeItem(vt.GetNodeData(pNode.FirstChild));
58 pData^.item := DrawItem;
59 vt.NodeHeight[pNode.FirstChild] := 30;
60 end;
61begin
62 vt.NodeDataSize := SizeOf(TTreeItem);
63 mAddItem(itRectangle);
64 mAddItem(itOval);
65 mAddItem(itTriangle);
66end;
67
68procedure TForm1.vtBeforeCellPaint(Sender: TBaseVirtualTree;
69 TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
70 CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
71var
72 Data:PTreeItem;
73 r: TRect;
74 iHeight: Integer;
75begin
76 Data:= Sender.GetNodeData(Node);
77 if (Data = nil) then
78 Exit;
79 if vt.GetNodeLevel(Node) <> 1 then
80 Exit;
81 case Data^.item of
82 itRectangle:
83 iHeight := 90;
84 itOval:
85 iHeight := 20;
86 itTriangle:
87 iHeight := 50;
88 end;
89
90 if vt.NodeHeight[Node] <> iHeight then
91 vt.NodeHeight[Node] := iHeight;
92end;
93
94procedure TForm1.vtDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
95var
96 Data:PTreeItem;
97 r: TRect;
98begin
99 Data:= Sender.GetNodeData(PaintInfo.Node);
100 if (Data = nil) then
101 Exit;
102 r := PaintInfo.ContentRect;
103 inc(r.Top, 3);
104 case vt.GetNodeLevel(PaintInfo.Node) of
105 0:
106 begin
107 PaintInfo.Canvas.Font.Color := clRed;
108 case Data^.item of
109 itRectangle:
110 PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Obdélník');
111 itOval:
112 PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Ovál');
113 itTriangle:
114 PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Trojúhelník');
115 end;
116 end;
117 1:begin
118 case Data^.item of
119 itRectangle:
120 begin
121 PaintInfo.Canvas.Brush.Color := clGreen;
122 PaintInfo.Canvas.Rectangle(r.Left, r.Top, 100, r.Top + 80);
123 end;
124 itOval:
125 begin
126 PaintInfo.Canvas.Brush.Color := clYellow;
127 PaintInfo.Canvas.Ellipse(r.Left + 20, r.Top, r.Left + 50, r.Bottom);
128 end;
129 itTriangle:
130 begin
131 PaintInfo.Canvas.Brush.Color := clGradientActiveCaption;
132 PaintInfo.Canvas.Polygon([Point(r.Left, r.Top), Point(r.Left + 40, r.Top),
133 Point(r.Left + 20, r.Bottom)]);
134 end;
135 end;
136 end;
137 end;
138end;
139
140procedure TForm1.vtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
141var
142 Data:PTreeItem;
143begin
144 Data:= Sender.GetNodeData(Node);
145 if (Data = nil) then
146 Exit;
147 Finalize(Data^);
148end;
149
150end.
Ve FormCreate je stromu nastavena velikost datové struktury (řádek 62) a přidány a inicializovány všechny uzly. Vždy je vytvořen uzel pro text a poduzel pro obrázek.
V metodě vtBeforeCellPaint (obsluha OnBeforeCellPaint) nastavujeme výšku poduzlů v závislosti na datech.
Metoda vtFreeNode (obsluha OnFreeNode) uvolňuje data při uvolnění uzlu z paměti.
Jádrem programu je metoda vtDrawNode (obsluha OnDrawNode). Zde se provádí vlastní kreslení v závislosti na úrovni uzlu (0 - text, 1 - geometrie) a typu v datech (obdélník, ovál nebo trojúhelník). Jak by řekl Zdeněk: je to jednoduché jako žebřík.
Pozn: nepoužíval jsem with, které bych normálně použil a které se zde vyloženě nabízí a to jen z důvodu čtení kódu.
PS: Uvedený program je vykonstruovaný, zde je ale screenshot z našeho CRMplus, kde kromě kreslení (včetně přechodů)
je pak i detekce kliknutí na odkaz - to jen pro ukázku, že uvedené je opravdu jen principiální základ.
RSS