VirtualDrawTree

vložil Radek Červinka 8. března 2011 23:20

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é.

TVirtualDrawTree

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    { Private declarations }
   21  public
   22    { Public declarations }
   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{$R *.dfm}
   38
   39procedure TForm1.FormCreate(Sender: TObject);
   40  procedure mAddItem(DrawItem: TItemType);
   41  var
   42    pNode: PVirtualNode;
   43    pData: PTreeItem;
   44  begin
   45    // uzel
   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    // poduzel
   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; // calculated later
   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 // jen child node budeme nastavovat
   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.

CRMplus


Nabízíme Delphi školení na různá témata, primárně ve Vaší firmě.

Tagy: , , ,

Komponenty

Komentování ukončeno

Naše nabídka

Partial English version.

MVP
Ing. Radek Červinka - Embarcadero MVP
profil na linkedin, Twitter:@delphicz

Nabízím placené poradenství a konzultace v oblasti programování a vývoje SW.
Dále nabízíme i vývoj speciálního software na zakázku.

Neváhejte nás kontaktovat (i ohledně reklamy nebo burzy práce).

Pokud chcete podpořit tento server libovolnou částkou, můžete použít PayPal. Moc děkuji.

Delphi Certified Developer

O Delphi.cz

Delphi je jediný moderní RAD nástroj podporující tvorbu nativních aplikací pro platformu Win32, Win64 , Mac OSX a na iPhone a Android (s výhledem na další platformy díky FireMonkey) na současném trhu (včetně Windows 8.1).

V současnosti je světová komunita přes dva miliónů vývojářů.

Delphi.cz je nezávislý portál pro uživatele Delphi. Portál není koncipován pro úplné začátečníky, i když i ti se zde nebudou nudit, ale spíše na programátory, kteří již něco znají a chtějí své znalosti dále rozvíjet a sledovat novinky.

Anketa

Poslední komentáře

Comment RSS