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.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees;
type
TForm1 = class(TForm)
vt: TVirtualDrawTree;
procedure FormCreate(Sender: TObject);
procedure vtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vtBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode;
CellRect: TRect; var ContentRect: TRect);
private
{ Private declarations }
public
{ Public declarations }
end;
TItemType = (itRectangle, itOval, itTriangle);
PTreeItem=^TTreeItem;
TTreeItem = Record
item: TItemType;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
procedure mAddItem(DrawItem: TItemType);
var
pNode: PVirtualNode;
pData: PTreeItem;
begin
// uzel
vt.ChildCount[vt.RootNode] := vt.ChildCount[vt.RootNode] + 1;
vt.ValidateNode(vt.RootNode, False);
pNode := vt.RootNode.LastChild;
pData := PTreeItem(vt.GetNodeData(pNode));
pData^.item := DrawItem;
vt.NodeHeight[pNode] := 20;
// poduzel
vt.ChildCount[pNode] := 1;
vt.ValidateNode(pNode, True);
pData := PTreeItem(vt.GetNodeData(pNode.FirstChild));
pData^.item := DrawItem;
vt.NodeHeight[pNode.FirstChild] := 30; // calculated later
end;
begin
vt.NodeDataSize := SizeOf(TTreeItem);
mAddItem(itRectangle);
mAddItem(itOval);
mAddItem(itTriangle);
end;
procedure TForm1.vtBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data:PTreeItem;
r: TRect;
iHeight: Integer;
begin
Data:= Sender.GetNodeData(Node);
if (Data = nil) then
Exit;
if vt.GetNodeLevel(Node) <> 1 then // jen child node budeme nastavovat
Exit;
case Data^.item of
itRectangle:
iHeight := 90;
itOval:
iHeight := 20;
itTriangle:
iHeight := 50;
end;
if vt.NodeHeight[Node] <> iHeight then
vt.NodeHeight[Node] := iHeight;
end;
procedure TForm1.vtDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
var
Data:PTreeItem;
r: TRect;
begin
Data:= Sender.GetNodeData(PaintInfo.Node);
if (Data = nil) then
Exit;
r := PaintInfo.ContentRect;
inc(r.Top, 3);
case vt.GetNodeLevel(PaintInfo.Node) of
0:
begin
PaintInfo.Canvas.Font.Color := clRed;
case Data^.item of
itRectangle:
PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Obdélník');
itOval:
PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Ovál');
itTriangle:
PaintInfo.Canvas.TextOut(r.Left, r.Top, 'Trojúhelník');
end;
end;
1:begin
case Data^.item of
itRectangle:
begin
PaintInfo.Canvas.Brush.Color := clGreen;
PaintInfo.Canvas.Rectangle(r.Left, r.Top, 100, r.Top + 80);
end;
itOval:
begin
PaintInfo.Canvas.Brush.Color := clYellow;
PaintInfo.Canvas.Ellipse(r.Left + 20, r.Top, r.Left + 50, r.Bottom);
end;
itTriangle:
begin
PaintInfo.Canvas.Brush.Color := clGradientActiveCaption;
PaintInfo.Canvas.Polygon([Point(r.Left, r.Top), Point(r.Left + 40, r.Top),
Point(r.Left + 20, r.Bottom)]);
end;
end;
end;
end;
end;
procedure TForm1.vtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data:PTreeItem;
begin
Data:= Sender.GetNodeData(Node);
if (Data = nil) then
Exit;
Finalize(Data^);
end;
end.
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