udiagramautolayout.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

      begin
       if Node.Box.Size.y > Highest then   //update maximum height
        Highest := Node.Box.Size.y;
       Node.Y := y;                        //set vertical position
      end;
    end;
   //increase vertical position by highest node and some spacing
   inc(Y, Highest + 4 * FDiagram.Margin);
  end;
end;





{Optimizes the horizontal positions of the nodes.
~param Spacing minimal horizontal space between nodes
~result sum of deltas to perfectly centered positions of all nodes }
function TSugiyamaLayouter.OptimizeHorizontalPositions(
                                                    Spacing: Integer): Integer;

 {Calculates the resulting horizontal force of all edges tearing at the node.
 ~param Node     the node the resulting horizontal force should be calculated
 ~param DeltaSum sum of deltas to perfectly centered positions of all nodes
 ~result the force the node is exposed to }
 function CalcForce(Node: PSortNode; var DeltaSum: Integer): Double;

  {Returns the horizontal center of the node.
  ~param Node the node, whose horizontal center should be returned
  ~result the horizontal center of the node }
  function InCenter(Node: PSortNode): Integer;
  begin
   Result := Node.X + Node.GetWidth div 2;  //position plus half width
  end;

 var      Center   :Integer;         //horizontal center of this node
          Sum      :Integer;         //the sum of all forces
          i        :Integer;         //counter through all edges
 begin
  //node has some edges?
  if (Node.InEdges.Count <> 0) or (Node.OutEdges.Count <> 0) then
   begin
    Center := InCenter(Node);          //get horizontal center of this node
    Sum := 0;                          //no force so far
    for i := 0 to Node.InEdges.Count - 1 do  //for each incoming edge
     inc(Sum, InCenter(Node.InEdges[i]) - Center);  //add its horizontal force
    for i := 0 to Node.OutEdges.Count - 1 do //for each emerging edge
     inc(Sum, InCenter(Node.OutEdges[i]) - Center); //add its horizontal force
    inc(DeltaSum, abs(Sum));           //add this force to sum of all deltas
    //weight force with sum of edges
    Result := Sum / (Node.InEdges.Count + Node.OutEdges.Count);
   end
  else
   Result := 0;                      //no edges, so no force affects it
 end;



var       Layer         :TList;     //each layer
          GroupStart    :Integer;   //start of a group of nodes in a layer
          GroupCount    :Integer;   //number of nodes in a group in a layer
          Force         :Double;    //sum of forces on whole group of nodes

 {Lets the force move the boxes. }
 procedure AdjustForForce;
 var       MaxAmount     :Integer;   //maximum amount the nodes can be moved
           Amount        :Integer;   //pixels to move the nodes in the group
           i             :Integer;   //counter through the nodex in the group
 begin
  if Force < 0 then                  //force pulls to the left?
   begin
    //get maximum number of pixel to be able to move to the left
    if GroupStart = 0 then
     //don't move over the left side (plus margin)
     MaxAmount := PSortNode(Layer[GroupStart]).X
    else
     //don't move over node at the left
     MaxAmount := PSortNode(Layer[GroupStart]).X -
                  (PSortNode(Layer[GroupStart - 1]).X +
                   PSortNode(Layer[GroupStart - 1]).GetWidth +
                   Spacing);
    Amount := Round(Force);            //get movement
    if Amount < -MaxAmount then        //and adjust with maximum
     Amount := -MaxAmount;
   end
  else
   begin
    //get maximum number of pixels to be able to move to the right
    if GroupStart + GroupCount = Layer.Count then
     //don't move too far to the right
     MaxAmount := High(Integer) - Spacing -
                  PSortNode(Layer[GroupStart +
                                  GroupCount - 1]).GetWidth
    else
     //don't move over node at the right
     MaxAmount := PSortNode(Layer[GroupStart + GroupCount]).X -
                  (PSortNode(Layer[GroupStart + GroupCount - 1]).X +
                   PSortNode(Layer[GroupStart + GroupCount -
                                   1]).GetWidth + Spacing);
    Amount := Round(Force);
    if Amount > MaxAmount then         //get movement
     Amount := MaxAmount               //and adjust with maximum
   end;

  if Amount <> 0 then                //group should be moved?
   for i := GroupStart to GroupStart + GroupCount - 1 do
    inc(PSortNode(Layer[i]).X, Amount);  //move each node in the group
 end;


var       i             :Integer;   //counter through all layers
          j             :Integer;   //counter through each layer
          LastForce     :Double;    //force on current node in the group
          //forces of each node in the current layer
          Forces        :array of Double;
begin
 //sum of deltas to perfectly centered positions of all nodes, none so far
 Result := 0;

 for i := 0 to FLayers.Count - 1 do //for each layer
  begin
   Layer := FLayers[i];               //get it

   SetLength(Forces, Layer.Count);    //array for affecting forces on each node

   for j := 0 to Layer.Count - 1 do //calculate forces on each node
    Forces[j] := CalcForce(Layer[j], Result); //and assign them

   //calculate groups of nodes that should keep together,
   //use groups of nodes instead of each node separately, so that two
   //neighbors do not block each other out

   GroupStart := 0;                 //start with first node in the layer
   while GroupStart < Layer.Count do //for each node/group of nodes
    begin
     LastForce := Forces[GroupStart]; //get force of first node in group
     Force := LastForce;              //the sum of the forces so far

     j := GroupStart + 1;             //for each other node in the group:
     //"touching" nodes with higher force belong to the same group
     while (j < Layer.Count) and (LastForce >= Forces[j]) and
           (PSortNode(Layer[j]).X -
            (PSortNode(Layer[j - 1]).X +
             PSortNode(Layer[j - 1]).GetWidth) <= Spacing) do
      begin
       LastForce := Forces[j];          //get force on the node
       Force := Force + LastForce;      //add to sum
       inc(j);                          //next node
      end;
     GroupCount := j - GroupStart;    //get number of nodes in the group
     Force := Force / GroupCount;     //"average"/weight force on the group

     if Force <> 0 then               //there is some force on the nodes?
      AdjustForForce;                   //let the force move the boxes


     inc(GroupStart, GroupCount)    //first node in the next group
    end; //while GroupStart < Layer.Count
  end; //for i := 0 to FLayers.Count - 1
end;


{Calculates horizontal positions of the boxes within the layers.}
procedure TSugiyamaLayouter.SetXPositions;
const     MaxIterations = 33;      //number of iterations to optimize positions

var       Spacing        :Integer;   //minimal spacing between nodes
          i, j           :Integer;   //general counters
          Layer          :TList;     //each layer
          X              :Integer;   //horizontal position of all nodes
          Node           :PSortNode; //each node
          //sum of deltas to perfectly centered positions of all nodes
          DeltaSum       :Integer;   //in an iteration
          OldDeltaSum    :Integer;   //previous sum of deltas of positions
          BailOut        :Integer;   //current iteration
begin
 Spacing := 2 * FDiagram.Margin;    //horizontal spacing of nodes

 //initialize horizontal position of each node based on its position within
 //the layer
 for i := 0 to FLayers.Count - 1 do //for each layer
  begin
   Layer := FLayers[i];               //get it
   X := 0;                            //start first node at the left side
   for j := 0 to Layer.Count - 1 do   //for each node in the layer
    begin
     Node := Layer[j];                  //get it
     Node.X := X;                       //set its vertical position
     inc(X, Spacing + Node.GetWidth);   //move position to the right
    end;
  end;


 OldDeltaSum := High(Integer);      //at least two iterations
 BailOut := 0;                      //before first iteration

 //try to optimize the horizontal positions
 repeat

   DeltaSum := OptimizeHorizontalPositions(Spacing);  //optimize the positions

   if DeltaSum >= OldDeltaSum then    //if no more improvement
    DeltaSum := 0;                      //stop optimizing
   OldDeltaSum := DeltaSum;           //save current delta

   inc(BailOut);               //another iteration of the optimization finished

 //stop if maximum number of iterations reached or no more improvement
 until (BailOut = MaxIterations) or (DeltaSum = 0);
end;







{Assigns the new layout by setting the boxes to their new positions. }
procedure TSugiyamaLayouter.ApplyNodes;
var       i              :Integer;      //counter through all nodes
begin
 for i := 0 to FNodes.Count - 1 do      //for each node
  with PSortNode(FNodes[i])^ do           //with it
   if assigned(Box) then                    //not a dummy?
    Box.Position := Point(X, Y);              //assign the new position
end;








































































   {   ******************     SimpleClassLayouter     ******************   }











{Checks whether the box (class) has no known parent in this diagram.
~param Box the box to check whether it has a parent
~result if the box has a parent }
function TSimpleClassLayouter.NoParent(Box: TBox): Boolean;
var      i       :Integer;       //counter through all associations
begin
 i := Box.AssociationCount - 1;  //count through each association
 while (i >= 0) and ((Box.Associations[i].Kind <> akInheriting) or
                     (Box.Associations[i].Source <> Box)) do
  dec(i);                         //until one found defining a parent
 Result := i < 0;                //return if association with parent found
end;

{Checks whether the box (class) has no known children (subclasses) in this
 diagram.
~param Box the box to check whether it has children
~result if the box has children }
function TSimpleClassLayouter.NoChildren(Box: TBox): Boolean;
var      i         :Integer;     //counter through all associations
begin
 i := Box.AssociationCount - 1;  //count through each association
 while (i >= 0) and ((Box.Associations[i].Kind <> akInheriting) or
                     (Box.Associations[i].Source = Box)) do
  dec(i);                         //until one found defining a child
 Result := i < 0;                //return if association with child found
end;

{Adds all children (subclasses) of the box (class) to the list.
~param Box          the box to get the children of
~param ChildrenList the list to add its children to, is cleared before that }
procedure TSimpleClassLayouter.GetChildren(Box: TBox; ChildrenList: TList);
var       i          :Integer;     //counter through all associations
begin
 ChildrenList.Clear;               //clear the list
 for i := 0 to Box.AssociationCount - 1 do //for each association
  with Box.Associations[i] do                //with it
   if (Kind = akInheriting) and (Destination = Box) then //defines a child?
    ChildrenList.Add(Source);                    //add it to the list
 assert(ChildrenList.Count > 0);
end;









{Positions all boxes in the diagram recursively.
~param Boxes the list of boxes to position, and all their descendants
~param XPos     in: most left horizontal position of the tree;
                out: next available position at the right of the tree
~param YPos     vertical position of all boxes in the list
~param MinWidth minimum width the whole list (including descendants) has to
                have }
procedure TSimpleClassLayouter.SetPositionTree(Boxes: TList; var XPos: Integer;
                                               YPos: Integer;
                                               MinWidth: Integer);

 {Distributes the list, breaks it where specified.
 ~param Filter the list to position in multiple columns }
 procedure DistributeBreaked(List: TList);
 var       NewY           :Integer;       //new vertical position
           //first boxes in the columns when column-breaks should be inserted
           Start          :Integer;       //in a column
           //maximum width of all boxes in the column to center it
           MaxX           :Integer;
           i, j           :Integer;       //counter through the classes
           Box            :TBox;          //each box in the list
 begin
  NewY := YPos;                       //vertical position of the classes
  Start := 0;                         //start with the first box
  repeat                              //until all boxes positioned
    MaxX := TBox(List[Start]).Size.x;   //get width of the column
    i := Start + 1;                     //for each box in the column
    while (i < List.Count) and not VerticalBreakAtBox(List[i]) do
     begin
      Box := List[i];