1:
2:
3:
4:
5:
6:

1    3
3    4
3    5
5    6
5    7
7    9                    

1:
2:
3:
4:

1
 3 4
   5  6
      7 9                    

1:
2:
3:
4:
5:
6:

id           gr_id       name
1             0          Autos
2             0          Fahrräder
3             1          Verbrenner
4             1          Elektro
5             3          1:8                    

1:
2:
3:
4:
5:

 - Autos
    - Verbrenner
      - 1:8
    - Elektro
 - Fahrräder                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

var
  MyTreeNode2: TTreeNode;
begin
 tv_eg1.Items.Clear;
 with ZQuery_GRUPPE do begin
  sql.Text:='SELECT * FROM GRUPPE WHERE GR_ID = 0';
  open;
 end;
 ZQuery_GRUPPE.First;
 repeat
  tv_eg1.Items.AddFirst( nil,ZQuery_GRUPPE.FieldByName('name').Text);
 until ZQuery_GRUPPE.FindNext=false;

 with ZQuery_GRUPPE do begin
  sql.Text:='SELECT * FROM GRUPPE WHERE GR_ID > 0';
  open;
 end;
 ZQuery_GRUPPE.First;
 repeat
  MyTreeNode2 := tv_eg1.Items[strtoint(ZQuery_GRUPPE.FieldByName('gr_id').Text)];
  tv_eg1.Items.AddChild(mytreenode2,ZQuery_GRUPPE.FieldByName('name').Text);
 until ZQuery_GRUPPE.FindNext=false;                    

1:
2:
3:
4:
5:

- Fahrräder
- Autos
  - Verbrenner
  - Elektro
    - 1:8                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

tv_eg1.Items.Clear;
 with ZQuery_GRUPPE do begin
  sql.Text:='SELECT * FROM GRUPPE ORDER BY ID ascending';
  open;
 end;
 While not ZQuery_GRUPPE.EoF do begin
  If ZQuery_GRUPPE.FieldByName('id_gr').AsInteger = 0 Then
    tv_eg1.Items.AddFirst( nil,ZQuery_GRUPPE.FieldByName('name').Text)
  Else begin
    MyGr_ID := ZQuery_GRUPPE.FieldByName('id_gr').AsInteger;
    MyName := ZQuery_GRUPPE.FieldByName('name').Text;
    AddSubNodeMain(MyGr_ID, MyName);
  end;
  ZQuery_GRUPPE.Next;
 end;                    

1:

 procedure AddSubNodeMain(MyGr_ID : Integer; MyName: String);                    

1:
2:
3:

 Node anlegen
 Kindertest durchfü0hren (where gr_id = id des akt. Nodes)
 bei Kindertest = JA ruft sich die Funktion selbst wieder auf, bei Kindertest = NEIN -> RAUS                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

procedure AddSubNodeMain(MyGr_ID : Integer; MyName: String);
var
  MyTreeNode: TTreeNode;
begin
 MyTreeNode := artikel_baum.tv_eg1.Items[mygr_id];
 artikel_baum.tv_eg1.Items.AddChild(MyTreeNode,myname);
 if kindertest(artikel_baum.ZQuery_GRUPPE.FieldByName('id').AsInteger) = 1 then
  AddSubNodeMain(artikel_baum.zquery_search.FieldByName('gr_id').asinteger,artikel_baum.zquery_search.FieldByName('name').text);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

function kindertest(id:integer):real;
var
  MyTreeNode: TTreeNode;
begin
 with artikel_baum.zquery_search do begin
  sql.Text:='SELECT * FROM GRUPPE WHERE ID = :searchid';
  With Params.ParamByName('searchid') do begin
   DataType := ftinteger;
   Value := id;
  End;
  open;
 end;
 if artikel_baum.zquery_search.RecordCount>0 then
  result:=1
 else result:=0;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:

{*******************************************************************************
Name         : uTreeView_Helper.pas
Coding by    : Helge ange
Date         : 27.02.2004
Last Update  : 27.02.2004
Version      : 1.0.001
Last Changes :

1.0.001-------------------------------------------------------------------------
- initial version
*******************************************************************************}
unit uTreeView_Helper;

interface

uses Windows, DB, ComCtrls, Classes, SysUtils, Controls, GlobalVars, ResClient;

Type RNodeData = packed record
       StringID : Integer;
       HookNr   : Integer;
     end; // RNodeData
     PNodeDate = ^RNodeData;

function TreeAddItem(Sender: TTreeView; IL: TImageList; pData : PConfigHookData; RC: TResClient; Resort: Boolean): TTreeNode;
function TreeFindItem(Sender: TTreeView; NodeItem: TTreeNode; Name: String): TTreeNode;

implementation

// In der ItemList sind in jedem String die Verweise auf die Bilder in der
// ImageList gespeichert. Nach der Nummer des Bildes folgt ein Leerzeichen
// und darauf der Text, welcher in der Liste erscheinen soll.
function TreeAddItem(Sender: TTreeView; IL: TImageList; pData: PConfigHookData; RC: TResClient; Resort: Boolean): TTreeNode;
var ThisNode, Node : TTreeNode;
    S : String;
    pND : PNodeDate;
begin
  Node := nil;
  // nil = level 0 Kein übergeordnetes Element = root
  // wird von TreeFindItem getestet
  S := RC.GetString(pData^.ParentName);
  ThisNode := TreeFindItem(Sender, Node, S);
  If ThisNode <> nil Then
    Node := ThisNode // Parent schon vorhanden
  Else begin
    New(pND);
    pND^.StringID := pData^.ParentName;
    pND^.HookNr := 0;
    Node := Sender.Items.AddChildObject(nil, S, pND);
    Node.ImageIndex := pData^.ParentImage;
    Node.SelectedIndex := pData^.ParentImage;
  end;  //  --  If ThisNode <> nil Then

  // jetzt den Eintrag für den Dialog
  New(pND);
  pND^.StringID := pData^.Name;
  pND^.HookNr := pData^.HookNr;
  S := RC.GetString(pData^.Name);
  ThisNode := Sender.Items.AddChildObject(Node, S, pND);
  ThisNode.ImageIndex := pData^.Image;
  ThisNode.SelectedIndex := pData^.Image;
  ThisNode.StateIndex := ThisNode.Level + 1;
  If Resort and (Node.Parent <> nil) Then
    Node.Parent.AlphaSort;
  Result := ThisNode;
end; // TreeAddItem

function TreeFindItem(Sender: TTreeView; NodeItem: TTreeNode; Name: String): TTreeNode;
begin
  if NodeItem = nil Then NodeItem := Sender.Items.GetFirstNode // this will be rootnode
                    Else NodeItem := NodeItem.GetFirstChild;
  // NodeItem ist das 1. Item des gewählten Levels
  // wenn dieses Level keine Items besitzt, ist NodeItem = nil
  if (NodeItem <> nil) and (NodeItem.Text <> Name) then
    repeat
      NodeItem := NodeItem.GetNextSibling;
    until (NodeItem = nil) or (NodeItem.Text = Name);
  Result := NodeItem;
end; // TreeFindItem

end.                    

1:
2:
3:
4:
5:
6:
7:
8:

...
 t: ttreeview;
 i: integer;
...
begin
 for i := 0 to t.items.count - 1 do
  listbox.items.add(t.Items[i].Text); //listbox nur zur erläuterung angegeben
end.                    

1:

 S := RC.GetString(pData^.ParentName);                    

1:

   pND^.HookNr := 0;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, contnrs;

type
  TForm1 = class(TForm)
    b: TButton;
    lb: TListBox;
    tv: TTreeView;
    od: TOpenDialog;
    procedure bClick(Sender: TObject);
    procedure tvDeletion(Sender: TObject; Node: TTreeNode);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
 tft= class (tobject)
  grp, nd: integer;
  bez: string;
 end;

procedure TForm1.bClick(Sender: TObject);
 procedure LoadAndSplit(const sl: tstringlist; const ol: tobjectList);
 var
  i: integer;
  ft: tft;
  s : string;
 begin
  for i := 0 to sl.Count - 1 do
  begin
   ft:= tft.create;
   s := sl.Strings[i];
   if s <> '' then
   begin
    ft.grp:= strtoint(copy(s,1,pos(',',s)-1));
    delete(s,1,pos(',',s));
    ft.nd:=strtoint(copy(s,1,pos(',',s)-1));
    delete(s,1,pos(',',s)); 
    ft.bez := s;
    ol.add(ft);
   end;
  end;
 end;
 procedure AddTV(const ol: tObjectList; nd: ttreenode);
  function AddNode(const ol: tObjectList;nd: tTreeNode): ttreenode;
  var
   dta: tft;
  begin
   dta := tft.Create;
   dta.grp := tft(ol.Items[0]).grp; //gruppenid
   dta.nd  := tft(ol.items[0]).nd;  //node id
   dta.bez := tft(ol.items[0]).bez; //knotenbezeichnung
   result  := tv.Items.AddChildObject(nd, tft(ol.Items[0]).bez, dta)
  end;
 begin
  if ol.Count > 0 then
  begin
   if tft(ol.Items[0]).grp = 0 then nd := NIL;
   if nd = NIL then
    nd:=addnode(ol, nd) //neuen Hauptknoten beginnen
   else 
    if tft(nd.Data).nd  = tft(ol.Items[0]).grp then //hier evtl. anpassungen vornehmen
     nd := addnode(ol, nd) //neuen Subknoten erstellen
    else
     nd := addnode(ol, nd.GetNext); //sonst neu positionieren
   ol.Delete(0);
   AddTV(ol,nd);
  end; 
 end;
 var
 sl: tstringlist;
 ol: tobjectlist;
 i : integer;
begin
 od.Filter := 'textdatei | *.txt';
 if od.execute and fileexists(od.FileName) then
 begin
  sl := tstringlist.Create;
  try
   sl.loadfromfile(od.FileName);
   ol := tobjectlist.Create;
   try
    LoadAndSplit(sl, ol);
    for i := 0 to ol.Count - 1 do
     lb.Items.Add(inttostr(tft(ol.Items[i]).grp)+', '+inttostr(tft(ol.items[i]).nd)+', '+tft(ol.items[i]).bez);
    AddTV(ol, NIL); 
   finally
    ol.Free;
   end;
  finally
   sl.free;
  end;
 end;
end;

procedure TForm1.tvDeletion(Sender: TObject; Node: TTreeNode);
begin
 if (node <> NIL) and (node.data <> NIL) then
 begin
  tobject(node.data).free;
  node.Data := NIL;
 end;
end;

end.                    

1:
2:

procedure TForm.TreeListExpanding(Sender: TObject;
  Node: TTreeNode; var AllowExpansion: Boolean);                    

1:

MyTreeNode := artikel_baum.tv_eg1.Items[mygr_id];                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

  function AddNode(const ol: tObjectList;nd: tTreeNode): ttreenode;
  var
   dta: tft;
  begin
   dta := tft.Create;
   dta.grp := tft(ol.Items[0]).grp; //gruppenid
   dta.nd  := tft(ol.items[0]).nd;  //node id
   dta.bez := tft(ol.items[0]).bez; //knotenbezeichnung
   result  := tv.Items.AddChildObject(nd, tft(ol.Items[0]).bez, dta)//hier wird ein neuer node erzeugt und zugewiesen.
  end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:

function TForm1.GetFieldList: TStringList;
var gruppen_id:integer;
    akt_id:integer;
    akt_gruppe:integer;
    id_wert:integer;
begin
 FieldList.clear;
 with form1.ZQuery2 do begin
  sql.Text:='SELECT * FROM GRUPPE WHERE ID = :GRUPPE';
  With Params.ParamByName('GRUPPE') do begin
   DataType := ftinteger;
   Value := form1.ZQuery1.fieldbyname('GR_ID').asinteger;
  End;
  open;
 end;
 if ZQuery2.RecordCount>0 then
  if ZQuery2.FieldByName('gr_id').asinteger > 0 then begin //ZUM ROOT VORDRINGEN
   akt_id:=ZQuery2.fieldbyname('id').AsInteger;
   akt_gruppe:=zQuery2.fieldbyname('gr_id').AsInteger;
   repeat
    with form1.ZQuery2 do begin
     sql.Text:='SELECT * FROM GRUPPE WHERE ID = :GRUPPE';
     With Params.ParamByName('GRUPPE') do begin
      DataType := ftinteger;
      Value := akt_gruppe;
     End;
     open;
    end;
    akt_gruppe:=ZQuery2.fieldbyname('GR_ID').AsInteger;
    if akt_gruppe=0 then repeat //ROOT GEFUNDEN NUN WIEDER TIEFER IN BAUM
     id_wert:= ZQuery2.fieldbyname('ID').asinteger;
     FieldList.add(ZQuery2.fieldbyname('NAME').asstring);
     with form1.ZQuery2 do begin
      sql.Text:='SELECT * FROM GRUPPE WHERE gr_id = :GRUPPE';
      With Params.ParamByName('GRUPPE') do begin
       DataType := ftinteger;
       Value := id_wert;
      End;
      open;
     end;
//     exit;
    until ID_wert = AKT_ID;
   until akt_gruppe=0;
  end //ZUM ROOT VORDRINGEN
  else
   repeat
    FieldList.add(ZQuery2.fieldbyname('NAME').asstring);
   until ZQuery2.FindNext=false;
 FieldList.add(ZQuery1.fieldbyname('NAME').asstring);

 Result := FieldList;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:

function TForm1.GetFieldList: TStringList;
var akt_gruppe:integer;
    i,j:integer;
begin
 FieldList.clear;
 with form1.ZQuery2 do begin
  sql.Text:='SELECT * FROM GRUPPE WHERE ID = :GRUPPE';
  With Params.ParamByName('GRUPPE') do begin
   DataType := ftinteger;
   Value := form1.ZQuery1.fieldbyname('GR_ID').asinteger;
  End;
  open;
 end;
 if ZQuery2.RecordCount>0 then
  if ZQuery2.FieldByName('gr_id').asinteger > 0 then begin //ZUM ROOT VORDRINGEN
   repeat
    FieldList.add(ZQuery2.fieldbyname('NAME').asstring);
    akt_gruppe:=zQuery2.fieldbyname('gr_id').AsInteger;
    with form1.ZQuery2 do begin
     sql.Text:='SELECT * FROM GRUPPE WHERE ID = :GRUPPE';
     With Params.ParamByName('GRUPPE') do begin
      DataType := ftinteger;
      Value := akt_gruppe;
     End;
     open;
    end;
   until akt_gruppe=0;
   i:= 0;
   j :=  FieldList.count-1;
   while i<j do
    begin
     FieldList.Exchange(I,J);
     inc(i);
     dec(j)
    end;
  end
  else
   repeat
    FieldList.add(ZQuery2.fieldbyname('NAME').asstring);
   until ZQuery2.FindNext=false;
 FieldList.add(ZQuery1.fieldbyname('NAME').asstring);
 Result := FieldList;
end;