uMain.pas

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, TeeGenericTree, Vcl.StdCtrls,
  Vcl.ExtCtrls, Math, Generics.Collections;

type NodeInformation = packed record
  Name: String;
  LocalX: Integer;
  Modv: Integer;
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox: TPaintBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure Draw(Tree: TNode<NodeInformation>);
  end;



var
  Form1: TForm1;

  procedure CenterNodesBetween(LeftNode, RightNode: TNode<NodeInformation>);

implementation

{$R *.dfm}

procedure GetLeftContour(Node: TNode<NodeInformation>; ModSum: Single;
  Dictionary: TDictionary<Integer, Single>);
var
  I: Integer;
  LocalModSum: Single;
begin
  LocalModSum := ModSum;

  if not (Dictionary.ContainsKey(Node.Level)) then begin
    Dictionary.Add(Node.Level, Node.Data.LocalX + LocalModSum);
  end else begin
    Dictionary.Items[Node.Level] := Min(Dictionary.Items[Node.Level],
      Node.Data.LocalX + LocalModSum);
  end;

  LocalModSum := LocalModSum + Node.Data.Modv;
  if (Node.Count > 0) then begin
    for I := 0 to Node.Count - 1 do begin
      GetLeftContour(Node[I], LocalModSum, Dictionary);
    end;
  end;
end;

function MaxKey(Values: TDictionary<Integer, Single>): Integer;
var
  MaxKey, I: Integer;
begin
  MaxKey := 0;
  if (Values.Count > 0) then begin
    for I := 0 to Values.Count - 1 do begin
      if Values.Keys.ToArray[I] > MaxKey then
        MaxKey := Values.Keys.ToArray[I];
    end;
  end;

  Result := MaxKey;
end;

procedure GetRightContour(Node: TNode<NodeInformation>; ModSum: Single;
  Dictionary: TDictionary<Integer, Single>);
var
  I: Integer;
  LocalModSum: Single;
begin
  LocalModSum := ModSum;

  if not (Dictionary.ContainsKey(Node.Level)) then begin
    Dictionary.Add(Node.Level, Node.Data.LocalX + LocalModSum);
  end else begin
    Dictionary.Items[Node.Level] := Max(Dictionary.Items[Node.Level],
      Node.Data.LocalX + LocalModSum);
  end;

  LocalModSum := LocalModSum + Node.Data.Modv;
  if (Node.Count > 0) then begin
    for I := 0 to Node.Count - 1 do begin
      GetLeftContour(Node[I], LocalModSum, Dictionary);
    end;
  end;
end;

procedure CheckForConflicts(Tree: TNode<NodeInformation>);
var
  MinDistance, TreeDistance, NodeSize, ShiftValue: Integer;
  NodeContour, SiblingContour: TDictionary<Integer, Single>;
  Level, Distance: Integer;
  Sibling: TNode<NodeInformation>;
begin
  TreeDistance := 5;
  NodeSize := 1;

  MinDistance := TreeDistance + NodeSize;
  ShiftValue := 0;
  SiblingContour := nil;

  NodeContour := TDictionary<Integer, Single>.Create();
  GetLeftContour(Tree, 0, NodeContour);

  { Get the left most node }
  if ((Tree.Parent <> nil) and (Tree.Parent.Count > 0)) then begin
    Sibling := Tree.Parent[0];
  end else begin
    Sibling := nil;
  end;

  while((Sibling <> nil) and (Sibling <> Tree)) do begin
    if (SiblingContour <> nil) then begin
      SiblingContour.Free;
    end;
    SiblingContour := TDictionary<Integer, Single>.Create();
    GetRightContour(Sibling, 0, SiblingContour);

    for Level := Tree.Level + 1 to Min(MaxKey(SiblingContour), MaxKey(NodeContour)) do begin
      Distance := Floor(NodeContour[Level] - SiblingContour[Level]);
      if (Distance + ShiftValue < MinDistance) then begin
        ShiftValue := MinDistance - Distance;
      end;
    end;

    if (shiftValue > 0) then begin
      Tree.Data.LocalX := Tree.Data.LocalX + ShiftValue;
      Tree.Data.Modv := Tree.Data.Modv + ShiftValue;
      CenterNodesBetween(Tree, Sibling);
      ShiftValue := 0;
    end;

    if (Sibling.Index <> Sibling.Parent.Count - 1) then begin
      Sibling := Sibling.Parent[Sibling.Index + 1];
    end else begin
      Sibling := nil;
    end;
  end;
end;

procedure CenterNodesBetween(LeftNode, RightNode: TNode<NodeInformation>);
var
  LeftIndex, RightIndex, NumNodesBetween, Count, I, DesiredX, Offset: Integer;
  DistanceBetweenNodes: Integer;
  MiddleNode: TNode<NodeInformation>;
begin
  LeftIndex := RightNode.Index;
  RightIndex := LeftNode.Index;

  NumNodesBetween := (RightIndex - LeftIndex) - 1;
  if (NumNodesBetween > 0) then begin
    DistanceBetweenNodes := (LeftNode.Data.LocalX - RightNode.Data.LocalX)
      div (NumNodesBetween + 1);

    Count := 1;
    for I := LeftIndex + 1 to RightIndex - 1 do begin
      MiddleNode := LeftNode.Parent[I];

      DesiredX := RightNode.Data.LocalX + (DistanceBetweenNodes * Count);
      Offset := DesiredX - MiddleNode.Data.LocalX;

      MiddleNode.Data.LocalX := MiddleNode.Data.LocalX + Offset;
      MiddleNode.Data.Modv := MiddleNode.Data.Modv + Offset;
      Inc(Count);
    end;

    CheckForConflicts(LeftNode);
  end;
end;

procedure CalculateFinalX(Tree: TNode<NodeInformation>; ModvSum: Integer);
var
  I: Integer;
begin
  Inc(Tree.Data.LocalX, ModvSum div 20);
  Inc(ModvSum, Tree.Data.Modv);

  if (Tree.Count > 0) then begin
    for I := 0 to Tree.Count-1 do begin
      CalculateFinalX(Tree[I], ModvSum);
    end;
  end;
end;

procedure CalculateInitialX(Tree: TNode<NodeInformation>);
const
  NodeSize = 1;
  SiblingDistance = 0;
var
  I, Mid: Integer;
  LeftChild, RightChild: TNode<NodeInformation>;
begin
  if (Tree.Count > 0) then begin
    for I := 0 to Tree.Count-1 do begin
      CalculateInitialX(Tree[I]);
    end;
  end;

  // If a leaf
  if (Tree.Count = 0) then begin
    if (Tree.Index > 0) then begin
      Tree.Data.LocalX := Tree.Parent[Tree.Index - 1].Data.LocalX + NodeSize + SiblingDistance;
    end else
      Tree.Data.LocalX := 0;
  end

  else if (Tree.Count = 1) then begin
    if (Tree.Index = 0) then begin
      Tree.Data.LocalX := Tree[0].Data.LocalX;
    end else begin
      Tree.Data.LocalX := Tree.Parent[Tree.Index - 1].Data.LocalX + NodeSize + SiblingDistance;
      Tree.Data.Modv := Tree.Data.LocalX - Tree.Parent[0].Data.LocalX;
    end;
  end

  else begin
    if (Tree.Level <> 0) then begin
      LeftChild := Tree.Parent[0];
      RightChild := Tree.Parent[Tree.Count - 1];
      Mid := (LeftChild.Data.LocalX + RightChild.Data.LocalX) div 2;

      if (Tree = LeftChild) then
        Tree.Data.LocalX := Mid
      else begin
        Tree.Data.LocalX := Tree.Parent[Tree.Index - 1].Data.LocalX + NodeSize + SiblingDistance;
        Tree.Data.Modv := Tree.Data.LocalX - Mid;
      end;
    end;
  end;

  if (Tree.Count > 0) and (Tree.Index <> 0) then begin
    CheckForConflicts(Tree);
  end;
end;

procedure TForm1.Draw(Tree: TNode<NodeInformation>);
var
  I: Integer;
  X, Y, pX, pY, Radius: Integer;
  Angle: Single;
begin
  Radius := 30;

  if Tree.Count > 0 then begin
    for I := 0 to Tree.Count - 1 do begin
      Draw(Tree[I]);
    end;
  end;

  X := Tree.Data.LocalX * 100 + 100;
  Y := Tree.Level * 100 + 100;
  PaintBox.Canvas.Ellipse(X - Radius, Y - Radius, X + Radius, Y + Radius);
  PaintBox.Canvas.TextOut(
    X - (PaintBox.Canvas.TextWidth(Tree.Data.Name) div 2),
    Y - (PaintBox.Canvas.TextHeight(Tree.Data.Name) div 2),
    Tree.Data.Name
  );

  if (Tree.Parent <> nil) then begin
    pX := Tree.Parent.Data.LocalX * 100 + 100;
    pY := Tree.Parent.Level * 100 + 100;

    PaintBox.Canvas.MoveTo(pX - Floor(Radius * Sin(Angle)), pY - Floor(Radius * Cos(Angle)));
    PaintBox.Canvas.LineTo(X - Floor(Radius * Sin(Angle)), Y - Floor(Radius * Cos(Angle)));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TreeA, TreeB: TNode<NodeInformation>;
  DataA, DataB, DataC, DataD, DataE: NodeInformation;
begin
  DataA.Name := 'Root';
  DataA.LocalX := 0;
  TreeA := TNode<NodeInformation>.Create(DataA);

  DataB.Name := 'Child A';
  DataB.LocalX := 0;
  TreeA.Add(DataB);

  DataC.Name := 'Child B';
  DataC.LocalX := 0;
  TreeB := TreeA.Add(DataC);
//
//  DataD.Name := 'Child C';
//  DataD.LocalX := 0;
//  TreeB.Add(DataD);
//
//  DataE.Name := 'Child D';
//  DataE.LocalX := 0;
//  TreeB.Add(DataE);

  CalculateInitialX(TreeA);
  CalculateFinalX(TreeA, 0);

  Draw(TreeA);
end;

end.