Steema Central

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;

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.

tom, fyi.

This must be something in the paint, because curiously enough when I was testing the save to bitmap code (export stuff we have been talking about), the saved bitmap (after a FullExpandContract(true) ) looked just fine. But only the saved bitmap .. not the on screen representation.

fwiw

I cannot reproduce that latest post.

Can you let me know what progress you are making on solving the sorting problem .. it is becoming a hassle for me.

thanks

Hi,

In Function TTreeExplorerAlignChild.DrawConnection(AConnection:TTreeConnection):Boolean;

At the end, remove optimization part, ie:

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;

weird, I'll send you my version of teeTree.pas

tom/chris .. did you send this .. I have not seen it.
I will try to send you a private message with email details

yes, I've sent you the source file.

please, sent me a message on tom@steema.com

I've replied to the private mail you've sent me, so it should arrive in your mailbox