Tree Connections appear to display incorrectly after sort
-
- Newbie
- Posts: 20
- Joined: Sat Oct 04, 2003 4:00 am
Tree Connections appear to display incorrectly after sort
I have attached some fairly comprehensive code to show what is happening as a result of a tree sort.
Tom, could you look into this please?
thanks
procedure TForm1.FormCreate(Sender: TObject);
{
This shows a bug in what happens when you do a sort.
When you expand the tree (after a sort),
the connections are painted wrongly
}
{ ====================== }
procedure addKids(const prefix : string;const toNode: TTreeNodeShape);
var k: integer; s: string;
begin
for k := 1 to 26 do begin
s := prefix+chr(ord('z') - k + 1) + inttostr(k);
toNode.Add(s);
end; // end for
end;
{ ====================== }
procedure ChangeOffsets;
var ExplorerAlign: TTreeExplorerAlignChild;
begin
// this is for experimentation ... does not affect outcomes
ExplorerAlign := Tree1.GlobalFormat.ChildManager as TTreeExplorerAlignChild;
ExplorerAlign.HorizMargin := 50; // offset of node image from vertical
ExplorerAlign.VertMargin := 30; // by experimentation .. works OK with 64x64 pics
ExplorerAlign.crossMargin := 20; // offset from the cross box
end;
{ ====================== }
procedure MakeConnectionsLookNice;
var k, knt: integer;
begin
knt := tree1.connections.count - 1;
for k := 0 to knt do begin
with tree1.Connections[k] do begin
// --------- Style (ie how the connecting line is drawn)
// TTreeConnectionStyle=(csAuto, csLine, csSides, csCurve, csInvertedSides);
Style := csAuto;
// -------- the connection line itself (it is called "border", but is really a pen)
// property Border:TTreeConnectionPen read GetBorder write SetBorder;
Border.Color := 1277625; //is a nice brown
Border.Style := psSolid;
Border.Width := 3; // the line thickness
end; // end for
end;
end;
{ ====================== }
procedure KillAllConnections;
var k: integer;
begin
for k := 0 to tree1.shapes.count - 1 do begin
tree1.Connections.DeleteAllTo(tree1.shapes[k]); // deletes all connections to this child
// not clear what happens to the associated connection data ??
end; // end for
end;
procedure ReconnectParentsWithKids(const anode:TTreeNodeShape);
var k: integer; knt : integer;
begin
knt := anode.children.count;
if knt =0 then exit;
for k := 0 to knt - 1 do begin
anode.AddconnectionObject(anode.children[k],nil);
end; // end for
for k := 0 to knt - 1 do begin
ReconnectParentsWithKids(anode.children[k]); // recurse down
end;
end;
var k: integer;
begin
tree1.AssignParent := true; // make nodes copy parent properties
tree1.AddRoot('I am root');
tree1.roots[0].color := clYellow;
// ChangeOffsets;
AddKids('top:',tree1.roots[0]);
// second level
for k := 1 to 26 do begin
AddKids('next=',tree1.roots[0].Children[k - 1]);
end; // end for
MakeConnectionsLookNice;
tree1.sort(true, true); // Ascending, IgnoreCase
tree1.invalidate;
{ the above sort results in all the first level connections becoming
"invisible" }
MakeConnectionsLookNice; // does not help
{
we try killing all the connections, then rebuilding them.
This works if the tree is not sorted, but not if it is sorted
- still get connections all over the place
}
KillAllConnections;
assert(tree1.connections.count=0,'should be no connections');
for k := 0 to tree1.Shapes.count-1 do begin
assert(tree1.shapes[k].connections.count =0,' the shape should have no connections');
end; // end for
ReconnectParentsWithKids(tree1.roots[0]);
// check if every node is connected to 1 or 2 others only
for k := 0 to tree1.Shapes.count-1 do begin
assert((tree1.shapes[k].connections.count <=2) and (tree1.shapes[k].connections.count >=1)
,' the shape ' + inttostr(k) +' should have 1 or 2 connections');
end; // end for
assert(tree1.roots[0].children.count=26,' wrong children of root ');
assert(tree1.roots[0].connections.count=26,' wrong connections of root ');
MakeConnectionsLookNice;
tree1.invalidate;
end;
Tom, could you look into this please?
thanks
procedure TForm1.FormCreate(Sender: TObject);
{
This shows a bug in what happens when you do a sort.
When you expand the tree (after a sort),
the connections are painted wrongly
}
{ ====================== }
procedure addKids(const prefix : string;const toNode: TTreeNodeShape);
var k: integer; s: string;
begin
for k := 1 to 26 do begin
s := prefix+chr(ord('z') - k + 1) + inttostr(k);
toNode.Add(s);
end; // end for
end;
{ ====================== }
procedure ChangeOffsets;
var ExplorerAlign: TTreeExplorerAlignChild;
begin
// this is for experimentation ... does not affect outcomes
ExplorerAlign := Tree1.GlobalFormat.ChildManager as TTreeExplorerAlignChild;
ExplorerAlign.HorizMargin := 50; // offset of node image from vertical
ExplorerAlign.VertMargin := 30; // by experimentation .. works OK with 64x64 pics
ExplorerAlign.crossMargin := 20; // offset from the cross box
end;
{ ====================== }
procedure MakeConnectionsLookNice;
var k, knt: integer;
begin
knt := tree1.connections.count - 1;
for k := 0 to knt do begin
with tree1.Connections[k] do begin
// --------- Style (ie how the connecting line is drawn)
// TTreeConnectionStyle=(csAuto, csLine, csSides, csCurve, csInvertedSides);
Style := csAuto;
// -------- the connection line itself (it is called "border", but is really a pen)
// property Border:TTreeConnectionPen read GetBorder write SetBorder;
Border.Color := 1277625; //is a nice brown
Border.Style := psSolid;
Border.Width := 3; // the line thickness
end; // end for
end;
end;
{ ====================== }
procedure KillAllConnections;
var k: integer;
begin
for k := 0 to tree1.shapes.count - 1 do begin
tree1.Connections.DeleteAllTo(tree1.shapes[k]); // deletes all connections to this child
// not clear what happens to the associated connection data ??
end; // end for
end;
procedure ReconnectParentsWithKids(const anode:TTreeNodeShape);
var k: integer; knt : integer;
begin
knt := anode.children.count;
if knt =0 then exit;
for k := 0 to knt - 1 do begin
anode.AddconnectionObject(anode.children[k],nil);
end; // end for
for k := 0 to knt - 1 do begin
ReconnectParentsWithKids(anode.children[k]); // recurse down
end;
end;
var k: integer;
begin
tree1.AssignParent := true; // make nodes copy parent properties
tree1.AddRoot('I am root');
tree1.roots[0].color := clYellow;
// ChangeOffsets;
AddKids('top:',tree1.roots[0]);
// second level
for k := 1 to 26 do begin
AddKids('next=',tree1.roots[0].Children[k - 1]);
end; // end for
MakeConnectionsLookNice;
tree1.sort(true, true); // Ascending, IgnoreCase
tree1.invalidate;
{ the above sort results in all the first level connections becoming
"invisible" }
MakeConnectionsLookNice; // does not help
{
we try killing all the connections, then rebuilding them.
This works if the tree is not sorted, but not if it is sorted
- still get connections all over the place
}
KillAllConnections;
assert(tree1.connections.count=0,'should be no connections');
for k := 0 to tree1.Shapes.count-1 do begin
assert(tree1.shapes[k].connections.count =0,' the shape should have no connections');
end; // end for
ReconnectParentsWithKids(tree1.roots[0]);
// check if every node is connected to 1 or 2 others only
for k := 0 to tree1.Shapes.count-1 do begin
assert((tree1.shapes[k].connections.count <=2) and (tree1.shapes[k].connections.count >=1)
,' the shape ' + inttostr(k) +' should have 1 or 2 connections');
end; // end for
assert(tree1.roots[0].children.count=26,' wrong children of root ');
assert(tree1.roots[0].connections.count=26,' wrong connections of root ');
MakeConnectionsLookNice;
tree1.invalidate;
end;
Hi JackLeslie,
thanks for the code, there is indeed something going wrong, we'll look into it. A small tip: Instead of using the MakeConnectionsLookNice procedure, you could use the GlobalFormat record instead. Eg in your FormCreate method, as first lines, you could use following code:
GlobalFormat = record containing default and global values.
thanks for the code, there is indeed something going wrong, we'll look into it. A small tip: Instead of using the MakeConnectionsLookNice procedure, you could use the GlobalFormat record instead. Eg in your FormCreate method, as first lines, you could use following code:
Code: Select all
with Tree1.GlobalFormat.Connection do
begin
Style := csAuto;
// -------- the connection line itself (it is called "border", but is really a pen)
// property Border:TTreeConnectionPen read GetBorder write SetBorder;
Border.Color := 1277625; //is a nice brown
Border.Style := psSolid;
Border.Width := 3
end;
Last edited by tom on Tue Feb 28, 2006 10:03 am, edited 1 time in total.
-
- Newbie
- Posts: 20
- Joined: Sat Oct 04, 2003 4:00 am
-
- Newbie
- Posts: 20
- Joined: Sat Oct 04, 2003 4:00 am
Hi,
In Function TTreeExplorerAlignChild.DrawConnection(AConnection:TTreeConnection):Boolean;
At the end, remove optimization part, ie:
In Function TTreeExplorerAlignChild.DrawConnection(AConnection:TTreeConnection):Boolean;
At the end, remove optimization part, ie:
Code: Select all
with Tree.IBounds2D do
if tmpY<=Bottom then
begin
//more code here
end;{ Optimization fails when nodes are sorted and there are more nodes than height of treepanel
else
if ToShape.Parent=FromShape then
result:=False;}
-
- Newbie
- Posts: 20
- Joined: Sat Oct 04, 2003 4:00 am
No, that does not seem to make any difference.
I patched it according to your instructions, the full code for that function is below, as is a testbed. Everything is dynamically created so there is no doubt I am linking in the right unit
When you have found the problem could you please email me your version of teetree.pas, so I know we are working with the same code.
email is John Aitchison AT the data sciences group DOT com (no spaces)
Thanks
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
ExtCtrls,
TeeProcs,
TeeTreePatched;
type
TForm1 = class(TForm)
btnAddNodesAndSort: TButton;
procedure btnAddNodesAndSortClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btnAddNodesAndSortClick(Sender: TObject);
var k, j: integer; anode: TTreeNodeShape;
var tree1 : TTreePatched;
begin
tree1 := TtreePatched.create(self);
tree1.parent := self;
tree1.top :=100;
tree1.visible := true;
tree1.clear;
with Tree1.GlobalFormat.Connection do
begin
Style := csAuto;
// -------- the connection line itself (it is called "border", but is really a pen)
Border.Color := clNavy;
Border.Style := psSolid;
Border.Width := 3
end;
tree1.beginupdate;
tree1.addroot('hello');
// add nodes in descending alphabetical order
for k := 1 to 26 do begin
anode := tree1.roots[0].add(chr(ord('z') - k + 1)+inttostr(k));
for j := 1 to 26 do begin
anode.add(chr(ord('z') - j + 1)+inttostr(k)+inttostr(j));
end; // end for
end;
tree1.sort(true,true); // ascending, ignore case
tree1.endupdate;
tree1.fullexpandcollapse(true);
end;
end.
//JA
type TTreePatched = class(TTree);
implementation
===============================
Function TTreeExplorerAlignChild.DrawConnection(AConnection:TTreeConnection):Boolean;
{
//JA Modified on advice of Steema to avoid connection drawing
problems when nodes are sorted
}
Var P : TPoint;
tmp : Integer;
tmpX : Integer;
tmpY : Integer;
tmpY2 : Integer;
tmpYC : Integer;
tmpArrowTo : TConnectionArrowTo;
tmpPrep : Boolean;
tmpPrev : TTreeNodeShape;
begin
result:=True;
tmpPrep:=False;
With AConnection, Points do
begin
if Length(Item)<>2 then SetLength(Item,3);
tmp:=ToShape.BrotherIndex;
if tmp>0 then
begin
// Assert ToShape.Parent should not be nil
tmpPrev:=ToShape.Parent.Children[tmp-1];
P:=CalcXYCross(tmpPrev,ToShape.Parent);
with Item[0] do
begin
X:=P.X;
Y:=P.Y;
XStyle:=cpsFixed;
YStyle:=cpsFixed;
end;
With Tree.CrossBox do
if Visible and (Size>0) and tmpPrev.ShouldDrawCross then
Inc(Item[0].Y,Size);
P:=CalcXYCross(ToShape,FromShape);
end
else
begin
P:=CalcXYCross(ToShape,FromShape);
Item[0].X:=P.X;
tmpYC:=FromShape.YCenter;
Item[0].Y:=tmpYC;
if Tree.ShowImages and (FromShape.IImageHeight>0) then
tmpY:=2+(FromShape.IImageHeight div 2)
else
With FromShape.Bounds do tmpY:=1+((Bottom-Top) div 2);
if ToShape.YCenter<tmpYC then Dec(Item[0].Y,tmpY)
else Inc(Item[0].Y,tmpY);
end;
with Item[1] do
begin
X:=P.X;
Y:=P.Y;
XStyle:=cpsFixed;
YStyle:=cpsFixed;
end;
// draw arrow "from"
With InternalArrowFrom do
if Style<>casNone then Draw(Item[0],180);
With Tree.CrossBox do
if Visible and (Size>0) and ToShape.ShouldDrawCross and
(FromShape=ToShape.Parent) then
begin
tmpY:=Item[1].Y;
if ToShape.Y1<FromShape.Y1 then Inc(tmpY,Size)
else Dec(tmpY,Size);
tmpY2:=Item[0].Y;
with Tree.IBounds2D do
begin
if tmpY>Bottom then tmpY:=Bottom
else
if tmpY<Top then tmpY:=Top;
if tmpY2>Bottom then tmpY2:=Bottom
else
if tmpY2<Top then tmpY2:=Top;
end;
if tmpY<>tmpY2 then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.VertLine3D(Item[0].X,tmpY2,tmpY,TeeTreeZ);
end;
tmpX:=Item[1].X;
if ToShape.X1<FromShape.X0 then Dec(tmpX,Size)
else Inc(tmpX,Size);
tmpY:=Item[1].Y;
with Tree.IBounds2D do
begin
if (tmpY<=Bottom) and (tmpY>=Top) then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.MoveTo3D(tmpX,tmpY,TeeTreeZ);
end;
end;
end
else
begin
tmpY:=Item[0].Y;
if tmpY<Tree.IBounds2D.Bottom then
begin
tmpY2:=Item[1].Y;
if tmpY2>Tree.IBounds2D.Top then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.VertLine3D(Item[0].X,tmpY,tmpY2,TeeTreeZ);
end;
end;
end;
tmpArrowTo:=InternalArrowTo;
Item[2]:=Item[1];
With ToShape do
if ImageAlignment=iaRight then
begin
Item[2].X:=AdjustedRectangle.Right;
if tmpArrowTo.Style<>casNone then Inc(Item[2].X,TeeTreeArrowMargin);
end
else
begin
Item[2].X:=AdjustedRectangle.Left;
if tmpArrowTo.Style<>casNone then Dec(Item[2].X,TeeTreeArrowMargin);
end;
Item[2].X := Item[2].X + Tree.ChartBounds.Left; //tom:26/10/2002; Print connection lines on correct place
tmpY:=Item[2].Y;
with Tree.IBounds2D do
if tmpY<=Bottom then
begin
// horizontal line
if tmpY>Top then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
end;
Tree.Canvas.LineTo3D(Item[2].X,tmpY,TeeTreeZ);
end;
(* //JA
This is the original code
end
else
if ToShape.Parent=FromShape then
result:=False;
replaced by the code below ie
1 line of code
end;
and a block of comments
*)
end;
{ Optimization fails when nodes are sorted
and there are more nodes than height of treepanel
else
if ToShape.Parent=FromShape then
result:=False;
}
{ draw arrow "to" }
if tmpArrowTo.Style<>casNone then tmpArrowTo.Draw(Item[2],ArrowToAngle);
// Connection text
if TextLinesCount>0 then DrawText(0);
end;
end;
I patched it according to your instructions, the full code for that function is below, as is a testbed. Everything is dynamically created so there is no doubt I am linking in the right unit
When you have found the problem could you please email me your version of teetree.pas, so I know we are working with the same code.
email is John Aitchison AT the data sciences group DOT com (no spaces)
Thanks
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
ExtCtrls,
TeeProcs,
TeeTreePatched;
type
TForm1 = class(TForm)
btnAddNodesAndSort: TButton;
procedure btnAddNodesAndSortClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btnAddNodesAndSortClick(Sender: TObject);
var k, j: integer; anode: TTreeNodeShape;
var tree1 : TTreePatched;
begin
tree1 := TtreePatched.create(self);
tree1.parent := self;
tree1.top :=100;
tree1.visible := true;
tree1.clear;
with Tree1.GlobalFormat.Connection do
begin
Style := csAuto;
// -------- the connection line itself (it is called "border", but is really a pen)
Border.Color := clNavy;
Border.Style := psSolid;
Border.Width := 3
end;
tree1.beginupdate;
tree1.addroot('hello');
// add nodes in descending alphabetical order
for k := 1 to 26 do begin
anode := tree1.roots[0].add(chr(ord('z') - k + 1)+inttostr(k));
for j := 1 to 26 do begin
anode.add(chr(ord('z') - j + 1)+inttostr(k)+inttostr(j));
end; // end for
end;
tree1.sort(true,true); // ascending, ignore case
tree1.endupdate;
tree1.fullexpandcollapse(true);
end;
end.
//JA
type TTreePatched = class(TTree);
implementation
===============================
Function TTreeExplorerAlignChild.DrawConnection(AConnection:TTreeConnection):Boolean;
{
//JA Modified on advice of Steema to avoid connection drawing
problems when nodes are sorted
}
Var P : TPoint;
tmp : Integer;
tmpX : Integer;
tmpY : Integer;
tmpY2 : Integer;
tmpYC : Integer;
tmpArrowTo : TConnectionArrowTo;
tmpPrep : Boolean;
tmpPrev : TTreeNodeShape;
begin
result:=True;
tmpPrep:=False;
With AConnection, Points do
begin
if Length(Item)<>2 then SetLength(Item,3);
tmp:=ToShape.BrotherIndex;
if tmp>0 then
begin
// Assert ToShape.Parent should not be nil
tmpPrev:=ToShape.Parent.Children[tmp-1];
P:=CalcXYCross(tmpPrev,ToShape.Parent);
with Item[0] do
begin
X:=P.X;
Y:=P.Y;
XStyle:=cpsFixed;
YStyle:=cpsFixed;
end;
With Tree.CrossBox do
if Visible and (Size>0) and tmpPrev.ShouldDrawCross then
Inc(Item[0].Y,Size);
P:=CalcXYCross(ToShape,FromShape);
end
else
begin
P:=CalcXYCross(ToShape,FromShape);
Item[0].X:=P.X;
tmpYC:=FromShape.YCenter;
Item[0].Y:=tmpYC;
if Tree.ShowImages and (FromShape.IImageHeight>0) then
tmpY:=2+(FromShape.IImageHeight div 2)
else
With FromShape.Bounds do tmpY:=1+((Bottom-Top) div 2);
if ToShape.YCenter<tmpYC then Dec(Item[0].Y,tmpY)
else Inc(Item[0].Y,tmpY);
end;
with Item[1] do
begin
X:=P.X;
Y:=P.Y;
XStyle:=cpsFixed;
YStyle:=cpsFixed;
end;
// draw arrow "from"
With InternalArrowFrom do
if Style<>casNone then Draw(Item[0],180);
With Tree.CrossBox do
if Visible and (Size>0) and ToShape.ShouldDrawCross and
(FromShape=ToShape.Parent) then
begin
tmpY:=Item[1].Y;
if ToShape.Y1<FromShape.Y1 then Inc(tmpY,Size)
else Dec(tmpY,Size);
tmpY2:=Item[0].Y;
with Tree.IBounds2D do
begin
if tmpY>Bottom then tmpY:=Bottom
else
if tmpY<Top then tmpY:=Top;
if tmpY2>Bottom then tmpY2:=Bottom
else
if tmpY2<Top then tmpY2:=Top;
end;
if tmpY<>tmpY2 then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.VertLine3D(Item[0].X,tmpY2,tmpY,TeeTreeZ);
end;
tmpX:=Item[1].X;
if ToShape.X1<FromShape.X0 then Dec(tmpX,Size)
else Inc(tmpX,Size);
tmpY:=Item[1].Y;
with Tree.IBounds2D do
begin
if (tmpY<=Bottom) and (tmpY>=Top) then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.MoveTo3D(tmpX,tmpY,TeeTreeZ);
end;
end;
end
else
begin
tmpY:=Item[0].Y;
if tmpY<Tree.IBounds2D.Bottom then
begin
tmpY2:=Item[1].Y;
if tmpY2>Tree.IBounds2D.Top then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
tmpPrep:=True;
end;
Tree.Canvas.VertLine3D(Item[0].X,tmpY,tmpY2,TeeTreeZ);
end;
end;
end;
tmpArrowTo:=InternalArrowTo;
Item[2]:=Item[1];
With ToShape do
if ImageAlignment=iaRight then
begin
Item[2].X:=AdjustedRectangle.Right;
if tmpArrowTo.Style<>casNone then Inc(Item[2].X,TeeTreeArrowMargin);
end
else
begin
Item[2].X:=AdjustedRectangle.Left;
if tmpArrowTo.Style<>casNone then Dec(Item[2].X,TeeTreeArrowMargin);
end;
Item[2].X := Item[2].X + Tree.ChartBounds.Left; //tom:26/10/2002; Print connection lines on correct place
tmpY:=Item[2].Y;
with Tree.IBounds2D do
if tmpY<=Bottom then
begin
// horizontal line
if tmpY>Top then
begin
if not tmpPrep then // optimization
begin
PrepareCanvas;
end;
Tree.Canvas.LineTo3D(Item[2].X,tmpY,TeeTreeZ);
end;
(* //JA
This is the original code
end
else
if ToShape.Parent=FromShape then
result:=False;
replaced by the code below ie
1 line of code
end;
and a block of comments
*)
end;
{ Optimization fails when nodes are sorted
and there are more nodes than height of treepanel
else
if ToShape.Parent=FromShape then
result:=False;
}
{ draw arrow "to" }
if tmpArrowTo.Style<>casNone then tmpArrowTo.Draw(Item[2],ArrowToAngle);
// Connection text
if TextLinesCount>0 then DrawText(0);
end;
end;
-
- Newbie
- Posts: 20
- Joined: Sat Oct 04, 2003 4:00 am