Solved

Build a tree in a combobox.

Posted on 2002-06-06
23
492 Views
Last Modified: 2011-09-20
I like to build a tree in a combobox.

I have a database with 4 fields.
I like to do a select * from table order by field1,field2,field3,field4

Then I like to fill a combobox with the result in form of a tree.

How can I do that?
0
Comment
Question by:wqclatre
  • 10
  • 9
  • 3
  • +1
23 Comments
 
LVL 27

Expert Comment

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

listening . . .
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7059003
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.....
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 7059013
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 ;-)
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7059023
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.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 7059182
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 ;-)
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7059808
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
0
 
LVL 1

Expert Comment

by:alx512
ID: 7061443
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.
0
 
LVL 1

Expert Comment

by:bes67
ID: 7061700
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

0
 
LVL 1

Expert Comment

by:alx512
ID: 7061727
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.
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7066724
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;
0
 
LVL 1

Expert Comment

by:alx512
ID: 7069558
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;
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 2

Author Comment

by:wqclatre
ID: 7069568
where do you get Node.Value in

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

0
 
LVL 1

Expert Comment

by:alx512
ID: 7069582
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]);


0
 
LVL 1

Expert Comment

by:alx512
ID: 7069584
Do you see the TAttrTree object in my comment above?
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7069585
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......

0
 
LVL 1

Expert Comment

by:alx512
ID: 7069593
This proc work fine in my project with my data.
Check your data for correct Level value.
0
 
LVL 1

Expert Comment

by:alx512
ID: 7069595
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.
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7069612
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.
0
 
LVL 1

Expert Comment

by:alx512
ID: 7069631
I find some error, will trying to correct it.
0
 
LVL 1

Expert Comment

by:alx512
ID: 7074799
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;
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7074841
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?


0
 
LVL 1

Accepted Solution

by:
alx512 earned 200 total points
ID: 7075038
You right. Is last proc work good?
0
 
LVL 2

Author Comment

by:wqclatre
ID: 7075067
It works wounderfoul.... Thanks!
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now