Build a tree in a combobox.

did you took a look to www.torry.ru?
(i guess there are some free components for that)

listening . . .

I don't like to use some special component for this.

I think that this should be posible to do with a real combobox. I Mean it is possible to move text in with:
  TCustomComboBox(Control).Canvas.TextOut(Rect.Left+18,Rect.Top,TComboBox(Control).Items[Index])
for example.....

well, this would not have the effect of an treeview,
but if it is enough for to indent the item-string by depth-level, then this may easy

can yo show some sample-data and
the result you want to have?

meikl ;-)

Ok say that I have a table like:


car          color        year      combi
volvo        red         1997      yes
volvo        red         1998      no
volvo        blue         1998      no
saab         blue        1998      yes

I like to get

volvo
   red
     1997
        yes
      1998    
        no
   blue
     1998
       no
saab
   blue
     1998
       yes


What I also like to have is Title for each column in boold.

well ok,
a sample just from head,
without your header
(don't know how to place it
->as one line or as four entries)

procedure populate_thelist(AList : TStrings; AQuery : TQuery);
const
  indentspace = '   ';
var
  h1,h2,h3,h4 : String;
begin
  if assigned(Alist) then
  begin
    //some inits
    AList.Clear;
    h1 := '';
    h2 := '';
    h3 := '';
    h4 := '';
    //prepare query
    if not AQuery.Active then
      AQuery.Open;
    AQuery.first;
    //work
    while not AQuery.Eof do
    begin
      if AQuery.Fields[0].AsString <> h1 then
      begin
        AList.Add(AQuery.Fields[0].AsString);
        h1 := AQuery.Fields[0].AsString;
      end;
      if AQuery.Fields[1].AsString <> h2 then
      begin
        AList.Add(IndentSpace+AQuery.Fields[1].AsString);
        h2 := AQuery.Fields[1].AsString;
      end;
      if AQuery.Fields[2].AsString <> h3 then
      begin
        AList.Add(IndentSpace+IndentSpace+AQuery.Fields[2].AsString);
        h3 := AQuery.Fields[2].AsString;
      end;
      if AQuery.Fields[3].AsString <> h4 then
      begin
        AList.Add(IndentSpace+IndentSpace+IndentSpace+AQuery.Fields[3].AsString);
        h4 := AQuery.Fields[3].AsString;
      end;
      AQuery.Next;
    end;
  end;
end;


calling sample
populate_thelist(combobox1.items,query1);

not tested

meikl ;-)

I tried it another way by during the query using AddObject and puting the level (TObject(integer)) in the combobox.

Then on OnDrawIntem use
 TCustomComboBox(Control).Canvas.TextOut(Rect.Left+rc,Rect.Top,TComboBox(Control).Items[Index])

Where rc depends on Integer(Combobox.Items.Objects[Index])

What I also tried was to paint lines in the combobox. To have it look like a treewiev. But I don't have the code where I'm sitting right now.
(I used
TCustomComboBox(Control).Canvas.MoveTO
And

TCustomComboBox(Control).LineTo)
It looks like I have missed something because It get som unwanted lines on some places.

If someone can help me paint a nice tree I would be glad to add 200 more points.

I will try to get back with the code I have right now in the beginning of next week

This is a code what i write for 2 hours:

unit AttrFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  PAttrData = ^TAttrData;
  TAttrData = record
    attrs: array of string[20];
  end;

  PAttrNode = ^TAttrNode;
  TAttrNode = record
    value: string[20];
    level: Integer;
    items: array of PAttrNode;
  end;

  TAttrDataArray = array of PAttrData;
  PAttrDataArray = ^TAttrDataArray;
  TAttrNodeArray = array of PAttrNode;
  PAttrNodeArray = ^TAttrNodeArray;

  TAttrTree = class(TObject)
  private
    FData:  TAttrDataArray;
    FNodes: TAttrNodeArray;
    FRootNode: TAttrNode;
    function NewAttrData(attrs: array of String): PAttrData;
    function FindNode(ANode: PAttrNode; ACar: PAttrData): PAttrNode;
    procedure MakeTree;
    procedure LoadNodes(ANode: PAttrNode);
    procedure LoadData; virtual;
  public
    destructor Destroy; override;
    procedure Load;
    procedure Clear;
  public
    property Data: TAttrDataArray read FData;
    property Nodes: TAttrNodeArray read FNodes;
    property RootNode: TAttrNode read FRootNode;
  end;

  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    AttrTree: TAttrTree;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

destructor TAttrTree.Destroy;
begin
  Clear;
  inherited;
end;

procedure TAttrTree.Clear;
var
  i: Integer;
begin
  for i:=0 to Length(FNodes)-1 do
    FreeMem(FNodes[i]);
  SetLength(FNodes, 0);
  for i:=0 to Length(FData)-1 do
    FreeMem(FData[i]);
  SetLength(FData, 0);
end;

procedure TAttrTree.Load;
begin
  Clear;
  LoadData;
  MakeTree;
  LoadNodes(@FRootNode);
end;

procedure TAttrTree.LoadData;
begin
  // place where the code that retriving data from the database
  SetLength(FData, 5); // recordcount
  FData[0] := NewAttrData(['volvo', 'red',  '1997', 'yes']);
  FData[1] := NewAttrData(['volvo', 'red',  '1998', 'no']);
  FData[2] := NewAttrData(['volvo', 'blue', '1998', 'no']);
  FData[3] := NewAttrData(['saab',  'blue', '1998', 'yes']);
  // You can easy add additional atributes, for example
  FData[4] := NewAttrData(['saab',  'green', '1998', 'yes', 'ABS']);
end;

function TAttrTree.NewAttrData(attrs: array of String): PAttrData;
var
  i: Integer;
begin
  GetMem(Result, sizeof(TAttrData));
  FillChar(Result^, sizeof(TAttrData), 0);
  SetLength(Result^.attrs, Length(attrs));
  for i:=0 to Length(attrs)-1 do
    Result^.attrs[i] := attrs[i];
end;

function TAttrTree.FindNode(ANode: PAttrNode; ACar: PAttrData): PAttrNode;
var
  i, Count: Integer;
begin
  Result := nil;
  Count := Length(ANode^.Items);
  for i:=0 to Count - 1 do
    if ANode^.Items[i]^.value = ACar^.attrs[ANode^.Level] then
    begin
      Result := ANode^.Items[i];
      break;
    end;
  if Result = nil then
  begin
    Count := Count + 1;
    SetLength(ANode^.Items, Count);
    GetMem(Result, sizeof(TAttrNode));
    FillChar(Result^, sizeof(TAttrNode), 0);
    Result.level := ANode.level + 1;
    Result.Value := ACar^.attrs[ANode^.Level];
    ANode^.Items[Count-1] := Result;
  end;
  if ANode^.level < Length(ACar^.attrs)-1 then
    Result := FindNode(Result, ACar);
end;

procedure TAttrTree.MakeTree;
var
  i: Integer;
begin
  for i:=0 to Length(FData)-1 do
    FindNode(@FRootNode, FData[i]);
end;

procedure TAttrTree.LoadNodes(ANode: PAttrNode);
var
  i, l, Count: Integer;
begin
  Count := Length(ANode^.Items);
  for i:=0 to Count-1 do
  begin
    l := Length(FNodes);
    SetLength(FNodes, l+1);
    FNodes[l] := ANode^.Items[i];
    LoadNodes(FNodes[l]);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AttrTree := TAttrTree.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  AttrTree.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  AttrTree.Load;
  ComboBox1.Style := csOwnerDrawFixed;
  ComboBox1.Items.Clear;
  for i:=0 to Length(AttrTree.Nodes)-1 do
    ComboBox1.Items.Add('');
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Node: PAttrNode;
begin
  Node := AttrTree.Nodes[Index];
  with TCustomComboBox(Control).Canvas do
  begin
    FillRect(Rect);
    if Node^.Level = 1 then
      Font.Style := [fsBold] else
      Font.Style := [];
    TextOut(Rect.Left+10*(Node^.Level-1)+1, Rect.Top, Node^.value);
  end;
end;

end.

Hi

I want to add a couple of KBs of source too :) and some explanations:
- drop combobox on your form
- set it's style to csOwnerDrawFixed
- fill it with rows from your query (as is, just separate field values with some delimiter character - space, for example)
- make some initialization (see Form's OnCreate handler)

and here is code

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Indent: Integer;
    Levels: Integer;
    prevlevel: TStringList;
    separatorstr: string;
  public
    { Public declarations }
    procedure FillComboItems(Combo: TCustomComboBox);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
// we do our initialization here
  Indent := 8;  // default Indent
  Levels := 4;  // Number of levels
  prevlevel := TStringList.Create; // Storage for level's values
  for i := 0 to Levels - 1 do      // and we initialize them
    prevlevel.Add('');             // with empty strings
  separatorstr := ' ';  // separator between columns of initial combobox content
  FillComboItems(ComboBox1); // Refill Comobox
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var tmp: string;
begin
  tmp := (Control as TCustomCombobox).Items[Index];
  with (Control as TCustomCombobox) do
  begin
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Index >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end;
    Canvas.FillRect(Rect);
    Rect.Left := Rect.Left +
                 Integer(Pointer((Control as TCustomCombobox).Items.Objects[Index])) *
                 Indent;
    Canvas.TextOut(Rect.Left,Rect.Top,tmp);
  end;
end;


procedure TForm1.FillComboItems(Combo: TCustomComboBox);

  function GetPartOfItem(fullstr: string; partindex: Integer): string;
  var st,i: integer;
  begin
    st := 1;
    for i := 0 to partindex - 1 do
    begin
      st := AnsiPos(separatorstr,fullstr);
      Delete(fullstr,1,st);
    end;
    st := AnsiPos(separatorstr,fullstr);
    if st <> 0 then
      Delete(fullstr,st,Length(fullstr));
    Result := fullstr;
  end;

  procedure EmptyRestOfPrevVals(prevLevel: TStrings; Index: Integer);
  var i: Integer;
  begin
    for i := Index + 1 to prevLevel.Count - 1 do
      prevLevel[i] := '';
  end;

var tmp: TStringList;
    str, part: string;
    i,j: Integer;
begin
  tmp := TStringList.Create;
  tmp.Assign(Combo.Items);
  Combo.Items.Clear;
  for i := 0 to tmp.Count - 1 do
  begin
    str := tmp[i];
    for j := 0 to Levels - 1 do
    begin
      part := GetPartOfItem(str, j);
      if AnsiCompareText(prevLevel[j], part) = 0 then
        Continue
      else begin
        prevLevel[j] := part;
        EmptyRestOfPrevVals(prevLevel,j);
        Combo.Items.AddObject(part,Pointer(j));
      end;
    end;
  end;
  tmp.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  prevlevel.Free;
end;

end.

Hope this will help

The code that i wrote is easy to modify and scale.
It can be used for others purposes.
Number of fields is unlimited.
Prepared data can be used in others components,
such as TTreeView.

Here comes the code I have right now.

Sometimes for some level the painting does not look ok.
Can someone see what I have missed?

procedure TQuoteForm.cbTestDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  ix,jx, CurrentLevel, LastLevel : Integer;
  DrawLevel : array [1..3] of Boolean;
begin
  TCustomComboBox(Control).Canvas.FillRect(Rect);

  if TTestItem(cbTest.Items.Objects[index]).level = 1 then
    rc:= 0
  else if TTestItem(cbTest.Items.Objects[index]).Level = 2 then
    rc:= 18
  else if TTestItem(cbTest.Items.Objects[index]).Level = 3 then
    rc:= 36
  else if TTestItem(cbTest.Items.Objects[index]).Level = 4 then
    rc:= 54;


  for jx := 1 to 3 do
    DrawLevel[jx]:= False;

  jx := Index+1;
  LastLevel:= TTestsItem(cbTest.Items.Objects[index]).Level;
  while (jx < cbTest.Items.Count) and (TTestsItem(cbTest.Items.Objects[jx]).Level >= 2) do
  begin
    CurrentLevel:= TTestsItem(cbTest.Items.Objects[jx]).Level;
    if CurrentLevel > 1 then
      DrawLevel[CurrentLevel-1]:= True;
    inc(jx);
    if CurrentLevel= 2 then
      Break;
  end;
  for ix := 1 to rc div 18 do
  begin
    if DrawLevel[ix] then
    begin
      TCustomComboBox(Control).Canvas.MoveTo((ix-1)*18+10,Rect.Top);
      TCustomComboBox(Control).Canvas.LineTo((ix-1)*18+10,rect.Bottom);
    end;
  end;
  if rc <> 0 then
  begin
    TCustomComboBox(Control).Canvas.MoveTo(Rect.Left+rc-8,Rect.Top+8);
    TCustomComboBox(Control).Canvas.LineTo(Rect.Left+rc,Rect.Top+8);
    TCustomComboBox(Control).Canvas.MoveTo(Rect.Left+rc-8,Rect.Top);
    TCustomComboBox(Control).Canvas.LineTo(Rect.Left+rc-8,Rect.Top+8);
  end;
  TCustomComboBox(Control).Canvas.TextOut(Rect.Left+rc,Rect.Top,TComboBox(Control).Items[Index]);

end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  i, j: Integer;
  Level: Integer;
  Levels: array [1..4] of Boolean;
begin
  with TCustomComboBox(Control).Canvas do
  begin
    FillRect(Rect);
    Level := cbTest.Items.Objects[Index]).Level;
    for i:=1 to 4 do Levels[i] := False;
    for i:=Index+1 to cbTest.Items.Count-1 do
      if TTestsItem(cbTest.Items.Objects[i]).Level >= Level then
        Levels[TTestsItem(cbTest.Items.Objects[i]).Level] := True
      else
        begin
          for j:=1 to TTestsItem(cbTest.Items.Objects[i]).Level do Levels[j] := True;
          break;
        end;

    Levels[2] := Levels[2] or Levels[1];
    for i:=1 to Level - 1 do
    if Levels[i+1] then
    begin
       MoveTo(Rect.Left+(i-1)*18+10, Rect.Top);
       LineTo(Rect.Left+(i-1)*18+10, Rect.Bottom);
    end;

    if Level > 1 then
    begin
      MoveTo(Rect.Left+(Level-2)*18+10, Rect.Top);
      LineTo(Rect.Left+(Level-2)*18+10, Rect.Bottom + (Rect.Top - Rect.Bottom) div 2);
      LineTo(Rect.Left+(Level-2)*18+10+17, Rect.Bottom + (Rect.Top - Rect.Bottom) div 2);
      if Levels[Level] then
      begin
        MoveTo(Rect.Left+(Level-2)*18+10, Rect.Top);
        LineTo(Rect.Left+(Level-2)*18+10, Rect.Bottom);
      end;
    end;
    TextOut(Rect.Left+18*(Level-1), Rect.Top, Node.value);
  end;
end;

where do you get Node.Value in

TextOut(Rect.Left+18*(Level-1), Rect.Top, Node.value);

I test this proc with my data...and forgort to replace this text. Replace this line with:

TCustomComboBox(Control).Canvas.TextOut(Rect.Left+rc,Rect.Top,TComboBox(Control).Items[Index]);

Do you see the TAttrTree object in my comment above?

Sorry That is should be :
   TextOut(Rect.Left+18*(Level-1), Rect.Top, TComboBox(Control).Items[Index]);

But it still don't looks complete ok.

The line vertical line for the keeps going where it not should. (for the first level)
for example


aaaaaaaaa
 |_  bbbbbbbbb
 |  |_cccccccc
 |   |_  ddddddddd


 
The first vertical line is always there......

This proc work fine in my project with my data.
Check your data for correct Level value.

Please, chek this code on your computer

unit AttrFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  PAttrData = ^TAttrData;
  TAttrData = record
    attrs: array of string[20];
  end;

  PAttrNode = ^TAttrNode;
  TAttrNode = record
    value: string[20];
    level: Integer;
    items: array of PAttrNode;
  end;

  TAttrDataArray = array of PAttrData;
  PAttrDataArray = ^TAttrDataArray;
  TAttrNodeArray = array of PAttrNode;
  PAttrNodeArray = ^TAttrNodeArray;

  TAttrTree = class(TObject)
  private
    FData:  TAttrDataArray;
    FNodes: TAttrNodeArray;
    FRootNode: TAttrNode;
    function NewAttrData(attrs: array of String): PAttrData;
    function FindNode(ANode: PAttrNode; ACar: PAttrData): PAttrNode;
    procedure MakeTree;
    procedure LoadNodes(ANode: PAttrNode);
    procedure LoadData; virtual;
  public
    destructor Destroy; override;
    procedure Load;
    procedure Clear;
  public
    property Data: TAttrDataArray read FData;
    property Nodes: TAttrNodeArray read FNodes;
    property RootNode: TAttrNode read FRootNode;
  end;

  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    AttrTree: TAttrTree;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

destructor TAttrTree.Destroy;
begin
  Clear;
  inherited;
end;

procedure TAttrTree.Clear;
var
  i: Integer;
begin
  for i:=0 to Length(FNodes)-1 do
    FreeMem(FNodes[i]);
  SetLength(FNodes, 0);
  for i:=0 to Length(FData)-1 do
    FreeMem(FData[i]);
  SetLength(FData, 0);
end;

procedure TAttrTree.Load;
begin
  Clear;
  LoadData;
  MakeTree;
  LoadNodes(@FRootNode);
end;

procedure TAttrTree.LoadData;
begin
  // place where the code that retriving data from the database
  SetLength(FData, 4); // recordcount
  FData[0] := NewAttrData(['volvo', 'red',  '1997', 'yes']);
  FData[1] := NewAttrData(['volvo', 'red',  '1998', 'no']);
  FData[2] := NewAttrData(['volvo', 'blue', '1998', 'no']);
  FData[3] := NewAttrData(['saab',  'blue', '1998', 'yes']);
  // You can easy add additional atributes, for example
//  FData[4] := NewAttrData(['saab',  'green', '1998', 'yes', 'ABS']);
end;

function TAttrTree.NewAttrData(attrs: array of String): PAttrData;
var
  i: Integer;
begin
  GetMem(Result, sizeof(TAttrData));
  FillChar(Result^, sizeof(TAttrData), 0);
  SetLength(Result^.attrs, Length(attrs));
  for i:=0 to Length(attrs)-1 do
    Result^.attrs[i] := attrs[i];
end;

function TAttrTree.FindNode(ANode: PAttrNode; ACar: PAttrData): PAttrNode;
var
  i, Count: Integer;
begin
  Result := nil;
  Count := Length(ANode^.Items);
  for i:=0 to Count - 1 do
    if ANode^.Items[i]^.value = ACar^.attrs[ANode^.Level] then
    begin
      Result := ANode^.Items[i];
      break;
    end;
  if Result = nil then
  begin
    Count := Count + 1;
    SetLength(ANode^.Items, Count);
    GetMem(Result, sizeof(TAttrNode));
    FillChar(Result^, sizeof(TAttrNode), 0);
    Result.level := ANode.level + 1;
    Result.Value := ACar^.attrs[ANode^.Level];
    ANode^.Items[Count-1] := Result;
  end;
  if ANode^.level < Length(ACar^.attrs)-1 then
    Result := FindNode(Result, ACar);
end;

procedure TAttrTree.MakeTree;
var
  i: Integer;
begin
  for i:=0 to Length(FData)-1 do
    FindNode(@FRootNode, FData[i]);
end;

procedure TAttrTree.LoadNodes(ANode: PAttrNode);
var
  i, l, Count: Integer;
begin
  Count := Length(ANode^.Items);
  for i:=0 to Count-1 do
  begin
    l := Length(FNodes);
    SetLength(FNodes, l+1);
    FNodes[l] := ANode^.Items[i];
    LoadNodes(FNodes[l]);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AttrTree := TAttrTree.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  AttrTree.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  AttrTree.Load;
  ComboBox1.Style := csOwnerDrawFixed;
  ComboBox1.Items.Clear;
  for i:=0 to Length(AttrTree.Nodes)-1 do
    ComboBox1.Items.Add('');
end;

end.

My levels are ok. I added them to the output with

TextOut(Rect.Left+18*(Level-1), Rect.Top, TComboBox(Control).Items[Index] + ' ' + IntToStr(TTestItem(cbTest.Items.Objects[Index]).Level));

To check them.

It is not all the time the vertical line is there.
If I know how to convert a Tcontrolcanvas to a tbitmap canvas I could send you a bitmap with my result so you could se it.

I find some error, will trying to correct it.

This is a correct code, use it:

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  i, j, Level, ItemLevel: Integer;
  Levels: array [1..4] of Boolean;
  S: String;
  IsLastNode, Flag: Boolean;
begin
  ItemLevel := TTestsItem(cbTest.Items.Objects[Index]).Level;
  with TCustomComboBox(Control).Canvas do
    begin
      FillRect(Rect);
      for i:=1 to 4 do Levels[i] := False;
      IsLastNode := True;
      for i:=Index+1 to cbTest.Items.Count-1 do
      begin
        Level := TTestsItem(cbTest.Items.Objects[i]).level;
        Flag := False;
        for j:=1 to Level-1 do Flag := Flag or Levels[j];
        if not Flag then Levels[Level] := True;
        if Level = ItemLevel then
          if not Flag then IsLastNode := False;
      end;

      Levels[2] := Levels[2] or Levels[1];
      for i:=1 to ItemLevel-1 do
      if Levels[i+1] then
      begin
        MoveTo(Rect.Left+(i-1)*18+10, Rect.Top);
        LineTo(Rect.Left+(i-1)*18+10, Rect.Bottom);
      end;

      if ItemLevel > 1 then
      begin
        MoveTo(Rect.Left+(ItemLevel-2)*18+10, Rect.Top);
        LineTo(Rect.Left+(ItemLevel-2)*18+10, Rect.Bottom + (Rect.Top - Rect.Bottom) div 2);
        LineTo(Rect.Left+(ItemLevel-2)*18+10+17, Rect.Bottom + (Rect.Top - Rect.Bottom) div 2);
        if not IsLastNode then
        begin
          MoveTo(Rect.Left+(ItemLevel-2)*18+10, Rect.Top);
          LineTo(Rect.Left+(ItemLevel-2)*18+10, Rect.Bottom);
        end;
      end;
      TextOut(Rect.Left+18*(ItemLevel-1), Rect.Top, cbTest.Items[i]);
    end;
end;

TextOut(Rect.Left+18*(ItemLevel-1), Rect.Top, cbTest.Items[i]);


should be

TextOut(Rect.Left+18*(ItemLevel-1), Rect.Top, cbTest.Items[Index]);

otherwise it writes the same text all the time. Right?

It works wounderfoul.... Thanks!