Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Lightweight bottom-up tree with variable size nodes

Posted on 2006-04-02
6
Medium Priority
?
195 Views
Last Modified: 2010-04-05
Hi
I'd like to build a tree display that is a bit unusual.

a) firstly the nodes are of different sizes .. that is, they have different amounts of text in them, multiple lines etc

b) I want the first level nodes to appear alternately left and right of the "main trunk", and left side nodes always expand out to the left, right side nodes to the right

c) conceptually at least, this is built from the bottom up. I am not sure that this makes any difference in practice, but that is my idea.

d) the tree is of unknown size, in general. Scrolling will be required.

I need some help getting started.

q1. What sort of container should I use for the tree? a Tscrollbox?

q2. For the nodes, should I use panels?

q3. I need some clues as to how to do the painting.  When the user scrolls, how do I determine what needs to be painted . What messages do I need to handle?

q4. The coordinate system will need to be "virtual" - in the sense that I cannot know in advance, until I start drawing, what the coordinates of any node should be. This will thus involve some negative coordinates .. do I need to map these back to a positive coordinate space?

I know there are good tree packages out there (like TeeTree and VirtualTreeView), but I want to try this for myself. It does not need to do much except draw itself and respond to expand/collapse clicks.

thanks
0
Comment
Question by:Mutley2003
  • 3
  • 3
6 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 16380019
you may take a look to this question i asked:

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_10331656.html

maybe it fits your needs

meikl ;-)
0
 

Author Comment

by:Mutley2003
ID: 16391096
thanks meikl .. there are some ideas there I can maybe try out.
I see igor used Tlabel as the container and for the nodes. hmm. Maybe that will work for me, but I am still confused about scrolling and when to paint.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 16391299
i used in my final panels instead, as viewarea i used a tscrollbox,
a special painting was not needed

i will dig out my final and post it here,
this may take a bit time, because its archived

meikl ;-)
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Accepted Solution

by:
kretzschmar earned 2000 total points
ID: 16393565
hmm,
i used a TCoolLabel,
but this is not important u can use any twincontrol,
just replace it

unit treechrt;

interface

uses sysutils, classes, contnrs, controls, extctrls,
     graphics, stdctrls, dbtables, coolCtrls, Forms, dialogs;

type
   TTreeChartsFilling = (tcfNone,tcfSolid,tcfSpecial);
   TTreeCharts = class; // forward definition
   TTreeChart  = class(TCoolLabel)
   public
     ID         : integer;
     ID_Parent  : integer;
     ID_ID      : integer;
     Data       : Pointer;
     ParentView : TTreeChart;  // parent visible object (TLabel)
     ParentNode : TTreeCharts; // parent list item
     Constructor Create(AOwner : TComponent); OverLoad;
     Constructor Create(ACaption : String); OverLoad;
   end;
   TTCDeletionEvent = procedure(Sender: TObject; Node: TTreeChart) of object;

   PTreeMetrics = ^TTreeMetrics;
   TTreeMetrics = record
     Width    : integer;
     Height   : integer;
     X_Indent : integer;
     Y_Indent : integer;
   end;

   TTreeCharts = class(TObjectList)
     Item        : TTreeChart;
     Parent      : TTreeCharts; // parent list item
     LastMetrics : TTreeMetrics;
     Filling  : TTreeChartsFilling;
     Color    : TColor;
     TCDeletionEvent : TTCDeletionEvent;
     destructor  Destroy; override;
     // tree building
     procedure   Resort;
     procedure   ExtractSubNodes(L : TObjectList);
     // position calc services
     procedure   MaxSubLevels(fCur : integer; var fMax : integer);
     procedure   IncSubCount(var CNT : integer);
     procedure   SetLeft(aMetrics : PTreeMetrics; aLeft : integer);
     // position calc methods
     procedure   CalcLeft(aMetrics : PTreeMetrics);
     procedure   CalcHeight(aMetrics : PTreeMetrics);
     procedure   CalcTop(aTop : integer);
     procedure   CalcMetrics(aMetrics : PTreeMetrics);
     procedure   CalcIndent(aMetrics : PTreeMetrics);
     // set view area
     procedure   SetView(aView : TWinControl);
     // edit/delete/add methods
     function    FindItem(aItem : TTreeChart) : TTreeCharts;
     procedure   DeleteItem;
     procedure   AddItem(aItem : TTreeChart);
     procedure   InsertItem(aItem : TTreeChart);
     procedure   InsertItemBefore(aItem : TTreeChart);
     Procedure   SetItemPropertys(aItem : TTreeChart);
     Procedure   SetPropertys;
     procedure   SetNewParent(OldParent, NewParent : TTreeCharts);
     procedure   SetOneNewParent(OldParent, NewParent : TTreeCharts);
     Function    RemoveItem : Boolean;
     Procedure   SetSelectedItem(aItem : TTreeChart);
   end;

   TTreeChartCreateProc = function(aQuery : TQuery) : TTreeChart;

const
   DefTreeMetrics : TTreeMetrics = // default visible item metrics
{   (Width    : 97;
    Height   : 21;
    X_Indent : 1;
    Y_Indent : 1);}
   (Width    : 150;
    Height   : 30;
    X_Indent : 1;
    Y_Indent : 1);
   tcDefColor = clInfoBK;
   tcFocColor = clSilver;

Var tcSelectedItem : TTreeChart;

function  DefTreeItemCreate(aQuery : TQuery) : TTreeChart;
function  BuildTreeItems(aQuery : TQuery; TreeItemCreate : TTreeChartCreateProc) : TTreeCharts;

implementation

function DefTreeItemCreate(aQuery : TQuery) : TTreeChart;
begin
  // aQuery = nil for Root item
  result:=TTreeChart.Create(Nil);
  if aQuery = nil then
  begin
    result.Caption:='Endprodukt';
    Result.Hint :='Endprodukt';
    Result.ShowHint := True;
    Result.ID := -1;
    Result.ID_Parent := -1;
    Result.ID_ID := -1;
  end;
//  result.Cursor:=crHandPoint;
end;

function BuildTreeItems(aQuery : TQuery; TreeItemCreate : TTreeChartCreateProc) : TTreeCharts;
var L : TObjectList;
    T : TTreeChart;
begin
  L := TObjectList.Create(False);

  aQuery.First;
  while not aQuery.EOF do
  begin
    T:=TreeItemCreate(aQuery);
    T.ID        := aQuery.Fields[0].AsInteger;
    if aQuery.Fields[1].IsNull then
      T.ID_Parent := -1
    else
      T.ID_Parent := aQuery.Fields[1].AsInteger;
    T.Caption   := aQuery.Fields[2].AsString;
    T.ID_ID     := aQuery.Fields[3].AsInteger;
    T.ParentShowHint := False;
    T.ShowHint  := true;
    T.Hint      := T.Caption;
    L.Add(T);
    aQuery.Next;
  end;

  result:=TTreeCharts.Create(False);
  result.Item:=TreeItemCreate(nil);
  result.ExtractSubNodes(L);
//  showmessage(IntToStr(L.Count));
  L.Free;
  result.Resort;
end;

Constructor TTreeChart.Create(ACaption : String);
Begin
  inherited Create(Nil);
  AutoSize:=false;
  Data := Nil;
  BevelOuter := bvRaised;
  Color := tcDefColor;
  SimpleView := True;
  LayOut := tlCenter;
  Alignment := taCenter;
  AutoSize := false;
  WordWrap := True;
  Caption := ACaption;
  ShowHint := True;
  Hint := ACaption;
end;

Constructor TTreeChart.Create(AOwner : TComponent);
Begin
  Inherited Create(AOwner);
  BevelOuter := bvRaised;
  Color := tcDefColor;
  SimpleView := True;
  LayOut := tlCenter;
  Alignment := taCenter;
  AutoSize := false;
  WordWrap := True;
  Data := Nil;
end;

Procedure TTreeCharts.SetSelectedItem(aItem : TTreeChart);
begin
  if assigned(aItem) then
  begin
    aItem.Color   := tcFocColor;
    tcSelectedItem := aItem;
  end
  else tcSelectedItem := Nil;
end;



Procedure   TTreeCharts.SetItemPropertys(aItem : TTreeChart);
begin
  if assigned(aItem) then
  begin
    aItem.Color   := tcDefColor;
  end;
end;




function CompareTreeItems(P1,P2 : pointer) : integer;
var T1,T2 : TTreeChart;
begin
  Result := 0;
  T1:=TTreeCharts(P1).Item;
  T2:=TTreeCharts(P2).Item;
  If T2.Caption < T1.Caption then
    Result := 1 else
  If T2.Caption > T1.Caption then
    Result := -1;
 //  result:=CompareText(T1.Caption, T2.Caption);
 // If Result = 0 then Result := 1;
end;


destructor  TTreeCharts.Destroy;
begin
  while Count > 0 do
    TTreeCharts(Items[0]).Free;
  if Assigned(Parent) then
    Parent.Extract(Self);
  if Assigned(Item) then
  begin
    If Assigned(TCDeletionEvent) then
      TCDeletionEvent(self,Item);
    if (Item.Parent <> nil) then
      Item.Parent.RemoveControl(Item);
    Item.Free;
  end;
  inherited;
end;

procedure   TTreeCharts.Resort;
var I : integer;
begin
  Sort(CompareTreeItems);
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).Resort;
end;

procedure   TTreeCharts.ExtractSubNodes(L : TObjectList);
var I : integer;
    T : TTreeCharts;
begin
  I:=0;
  while I < L.Count do
  if TTreeChart(L[I]).ID_Parent=Item.ID then
  begin
    T:=TTreeCharts.Create(False);
    T.Filling := Filling;
    T.Color := Color;
    Add(T);
    T.Item:=TTreeChart(L.Extract(L[I]));
    T.Item.ParentNode:=Self;
    T.Item.ParentView:=Self.Item;
    T.Parent:=Self;
  end else inc(I);
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).ExtractSubNodes(L);
end;


procedure   TTreeCharts.MaxSubLevels(fCur : integer; var fMax : integer);
var I : integer;
begin
  if fCur > fMax
     then fMax:=fCur;
  if Count > 0 then
    for I:=0 to Count-1 do TTreeCharts(Items[I]).MaxSubLevels(fCur+1,fMax);
end;

procedure   TTreeCharts.IncSubCount(var CNT : integer);
var I : integer;
begin
  if Count > 1 then inc(CNT,Count-1);
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).IncSubCount(CNT);
end;

procedure   TTreeCharts.CalcTop(aTop : integer);
var I : integer;
    T : TTreeCharts;
begin
  Item.Top:=aTop;
  for I:=0 to Count-1 do
  begin
    T:=TTreeCharts(Items[I]);
    T.CalcTop(aTop);
    aTop:=aTop+T.Item.Height;
  end;
end;

procedure   TTreeCharts.SetLeft(aMetrics : PTreeMetrics; aLeft : integer);
var I : integer;
begin
  Item.Left:=aLeft;
  Item.Width:=aMetrics.Width;
  SetItemPropertys(Item);
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).SetLeft(aMetrics, aLeft-aMetrics.Width);
end;

procedure   TTreeCharts.CalcLeft(aMetrics : PTreeMetrics);
var I,M : integer;
begin
  M:=0;
  MaxSubLevels(0,M);
  Item.Left:=M * aMetrics.Width;
  Item.Width:=aMetrics.Width;
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).SetLeft(aMetrics, Item.Left-aMetrics.Width);
end;

procedure   TTreeCharts.CalcHeight(aMetrics : PTreeMetrics);
var H : integer;
    I : integer;
begin
  H:=1;
  IncSubCount(H);
  Item.Height:=H*aMetrics.Height;
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).CalcHeight(aMetrics);
end;

procedure   TTreeCharts.CalcIndent(aMetrics : PTreeMetrics);
var I : integer;
begin
  Item.Width:=Item.Width-aMetrics.X_Indent* 2;
  Item.Left:=Item.Left+aMetrics.X_Indent;

  Item.Height:=Item.Height-aMetrics.Y_Indent *2;
  Item.Top:=Item.Top+aMetrics.Y_Indent;

  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).CalcIndent(aMetrics);
  Item.Visible := True;
end;

procedure   TTreeCharts.CalcMetrics(aMetrics : PTreeMetrics);
begin

  CalcLeft(aMetrics);
  CalcHeight(aMetrics);
  CalcTop(0);
  CalcIndent(aMetrics);
  LastMetrics:=aMetrics^;
end;


procedure   TTreeCharts.SetView(aView : TWinControl);
var I : integer;
begin
  SetItemPropertys(Item);
//  Item.Parent := aView;
  aView.InsertControl(Item);
  Item.OnMouseUp:=TStaticText(aView).onMouseUp;
  for I:=0 to Count-1 do
    TTreeCharts(Items[I]).SetView(aView);
end;

function    TTreeCharts.FindItem(aItem : TTreeChart) : TTreeCharts;
var I : integer;
    T : TTreeCharts;
begin
  result:=nil;
  if Item = aItem then result:=Self else
  for I:=0 to Count-1 do
  begin
    T:=TTreeCharts(Items[I]);
    result:=T.FindItem(aItem);
    if result<>nil then break;
  end;
end;

Procedure   TTreeCharts.SetPropertys;
var I : integer;
    T : TTreeCharts;
begin
  SetItemPropertys(Item);
  for I:=0 to Count-1 do
  begin
    T:=TTreeCharts(Items[I]);
    T.Filling := Filling;
    T.Color := Color;
    T.SetPropertys;
  end;
  tcSelectedItem := Nil;
end;



procedure TTreeCharts.DeleteItem;
begin
  If (Parent <> Nil) then
    Free;
end;

procedure  TTreeCharts.AddItem(aItem : TTreeChart);
var T : TTreeCharts;
begin
  T:=TTreeCharts.Create(False);
  Add(T);
  T.Item:=aItem;
  T.Item.ParentNode:=Self;
  T.Item.ParentView:=Self.Item;
  T.Parent:=Self;
  T.Item.Hint := T.Item.Caption;
  T.Item.ShowHint := True;
//  aItem.Parent := Item.Parent;
  Item.Parent.InsertControl(aItem);
  T.Item.Visible := False;
  T.Item.OnMouseUp:= TTreeChart(Item.Parent).OnMouseUp;
  T.Item.ID_Parent := Item.ID;
end;

procedure   TTreeCharts.SetNewParent(OldParent, NewParent : TTreeCharts);
var
  I : Integer;
begin
  For I := OldParent.Count - 1 downto 0 do
  begin
    if OldParent.Items[I] <> NewParent then
    begin
      TTreeCharts(OldParent.Items[I]).Item.ParentNode := NewParent;
      TTreeCharts(OldParent.Items[I]).Item.ParentView := NewParent.Item;
      TTreeCharts(OldParent.Items[I]).Parent := NewParent;
      TTreeCharts(OldParent.Items[I]).Item.ID_Parent := NewParent.Item.ID;
      NewParent.Add(OldParent.Extract(OldParent.Items[I]));
    end;
  end;
  NewParent.Resort;
end;



procedure   TTreeCharts.InsertItem(aItem : TTreeChart);
var T : TTreeCharts;
begin
  T:=TTreeCharts.Create(False);
  Add(T);
  T.Item:=aItem;
  T.Item.ParentNode:=Self;
  T.Item.ParentView:=Self.Item;
  T.Parent:=Self;
  Item.Parent.InsertControl(aItem);
  T.Item.Visible := False;
  T.Item.OnMouseUp:=TTreeChart(Item.Parent).OnMouseUp;
  SetNewParent(self,T);
end;

procedure   TTreeCharts.SetOneNewParent(OldParent, NewParent : TTreeCharts);
var
  I : Integer;
begin
  For I := Count - 1 downto 0 do
  begin
    if Items[I] = OldParent then
    begin
      NewParent.Add(Extract(Items[I]));
    end;
  end;
end;

procedure   TTreeCharts.InsertItemBefore(aItem : TTreeChart);
var
  I : Integer;
  T : TTreeCharts;
begin
  if Assigned(self.Parent) then
  begin
    T:=TTreeCharts.Create(False);
    Parent.Add(T);
    T.Item:=aItem;
    T.Item.ParentNode:=Self.Parent;
    T.Item.ParentView:=Self.Parent.Item;
    T.Parent:=Self.Parent;
//    aItem.Parent := Item.Parent;
    Item.Parent.InsertControl(aItem);
    T.Item.Visible := False;
    T.Item.OnMouseUp:=TTreeChart(Item.Parent).OnMouseUp;
    Parent.SetOneNewParent(self,T);
    Parent := T;
    Item.ParentNode := T;
    Item.ParentView := T.Item;
    Item.ID_Parent := aItem.ID;
  end;
end;

Function TTreeCharts.RemoveItem : Boolean;
var I : Integer;
begin
  Result := False;
  if Assigned(self.Parent) then
  begin
    SetNewParent(self,self.Parent);
    Result := True;
  end;
end;

initialization
  tcSelectedItem := Nil;
end.

if you send me a mail (my mail is in my profile),
i could send you back a screenshot, how it looks

meikl ;-)
0
 

Author Comment

by:Mutley2003
ID: 16514446
Hi meikl

I only just came across your latest comment .. yes I would like to see the screenshot.

sending you an email now

regards
0
 

Author Comment

by:Mutley2003
ID: 16924438
thanks meikl, got me on the right track
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
This is an update to some code that someone else posted on Experts Exchange. It is an alternate approach, I think a little easier to use, & makes sure that things like the Task Bar will update.
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
this video summaries big data hadoop online training demo (http://onlineitguru.com/big-data-hadoop-online-training-placement.html) , and covers basics in big data hadoop .
Suggested Courses

581 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