udiagramform.pas

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

 ZoomWindow.Width := Settings.ZoomWindowWidth;
 ZoomWindow.Height := Settings.ZoomWindowHeight;
end;

{Frees the form, the diagram, the zoom window and the set of diagrams.}
destructor TFormDiagram.Destroy;
var        Settings    :TDiagramFormSettings; //to save settings of form
begin
 //get object to save the settings in
 Settings := TDiagramFormSettings(TDiagramFormSettings.GetSettings(ClassName));
 if Assigned(Settings) then
  Settings.ReadValues(Self);                    //save current settings

 FActionFiles.Free;                           //free list for action

 FDiagramSet.Free;                            //free all saved diagrams

 FDiagram.Free;                               //free object to show diagrams

 FZoomWindow.Free;                            //free zoom window
 FZoomWindow := nil;                          //just to be sure

 inherited Destroy;                           //free this window
end;
























{$IFNDEF LINUX}

{Called when the size of the font is changed with the up- or down-button.
~param Sender the sender of the event, ~[link ComboBoxFontSize]
~param Button the button used to change the size of the font }
procedure TFormDiagram.UpDownFontSizeClick(Sender: TObject; Button: TUDBtnType);
begin
 ComboBoxFontSizeChange(Sender);             //just change the font size
end;

{$ENDIF}



{$IFNDEF LINUX}

{When minimized minimize the whole application, like the main form does.
~param Message the message parameters of the event }
procedure TFormDiagram.WMSysCommand(var Message: TWMSysCommand);
begin
 if Message.CmdType and $FFF0 = SC_MINIMIZE then //form is minimized?
  begin
   Application.Minimize;                     //minimize application instead
   Message.Result := 0;
  end
 else
  inherited;                                 //handle other messages
end;

{Called when the window is being moved. Used to keep track of the bottom left
 corner to adjust the position of the zoom window accordingly if needed.
~param Message the message parameters of the event }
procedure TFormDiagram.WMMove(var Message: TWMMove);
begin
 inherited;                           //handle the message
 BottomLeftChanged;                   //update the zoom window's position
end;

{$ENDIF}


{Called when the bottom left corner changed its position, used to
 move the zoom window accordingly if needed. }
procedure TFormDiagram.BottomLeftChanged;
var       X, Y        :Boolean; //if the right/lower sides were touching
begin
 if assigned(FZoomWindow) then  //zoom window already (and still) created?
  begin
   //check whether the right or lower sides of the this window and the
   //zoom window were touching each other (then the zoom window should be
   //moved so they touch again )
   X := abs(FOldBottomRight.x - (FZoomWindow.Left + FZoomWindow.Width)) < 10;
   Y := abs(FOldBottomRight.y - (FZoomWindow.Top + FZoomWindow.Height)) < 10;

   if X then                      //right sides are touching?
    //adjust horizontal position of the zoom window accordingly
    FZoomWindow.Left := Left + Width - FZoomWindow.Width
   else
    if Y then                       //touching somewhere?
     if FZoomWindow.Left < Left then  //make sure zoom window stays in this one
      FZoomWindow.Left := Left
     else
      if FZoomWindow.Left + FZoomWindow.Width > Left + Width then
       FZoomWindow.Left := Left + Width;

   if Y then                      //bottom sides are touching?
    //adjust vertical position of the zoom window accordingly
    FZoomWindow.Top := Top + Height - FZoomWindow.Height
   else
    if X then                       //touching somewhere?
     if FZoomWindow.Top < Top then    //make sure zoom window stays in this one
      FZoomWindow.Top := Top
     else
      if FZoomWindow.Top + FZoomWindow.Height > Top + Height then
       FZoomWindow.Top := Top + Height;

   //save current position of the lower right corner
   FOldBottomRight := Point(Left + Width, Top + Height);
  end;
end;






{Fills the tree view with all available files and record-like types. }
procedure TFormDiagram.FillTreeView;

 {Adds a node to the tree view sorted by its name.
 ~param Parent the node to add the node under
 ~param Name   the name of the node
 ~param Image  the image of the node
 ~param Value  the data of the node
 ~result the added node }
 function AddNode(Parent: TTreeNode; Name: String; Image: TImageIndex;
                  Value: TObject): TTreeNode;
 begin
  if not assigned(Parent) then            //no parent?
   Result := TreeView.Items.GetFirstNode    //get the first node on the level
  else
   Result := Parent.GetFirstChild;          //get first child

  if not assigned(Result) then              //no nodes on this level so far?
   if assigned(Parent) then                   //add as first node
    Result := TreeView.Items.AddChildObject(Parent, Name, Value)
   else
    Result := TreeView.Items.AddObject(nil, Name, Value)
  else
   begin
    //search position to insert the node alphabetically
    while assigned(Result) and (CompareText(Result.Text, Name) < 0) do
     Result := Result.GetNextSibling;

    if assigned(Result) then                  //not the last node?
     begin
      //add before the node
      Result := TreeView.Items.Insert(Result, Name);
      //WARNING!
      //InsertObject is faulty in Kylix, it will prepend to the parent!
      //so, here we do it in two statements
      Result.Data := Value;
     end
    else
     if assigned(Parent) then                  //add as last node
      Result := TreeView.Items.AddChildObject(Parent, Name, Value)
     else
      Result := TreeView.Items.AddObject(nil, Name, Value)
   end;

  Result.ImageIndex := ord(Image);        //set image of the node
  Result.SelectedIndex := ord(Image);
 end;


 {Adds the list and the inheritance trees (if inheritance is possible) of a
  kind of record-like types. Also adds nodes for the record-like types under
  the containing file nodes.
 ~param Files       the root node of the list of files
 ~param Kind        the kind of record-like types to add
 ~param Inheritance if record-likes types of that kind can inherit from others
                    and another list of inheritance trees should be created }
 procedure AddRecordLikes(Files: TTreeNode;
                          Kind: TRecordKind; Inheritance: Boolean);

  {Adds all children (sub-classes) of the class under its node recusively.
  ~param Parent the node of a class to add its children to }
  procedure AddChildren(Parent: TTreeNode);
  var       i          :Integer;          //counter through the children
            Child      :TIdentifier;      //each child/sub-class
  begin
   assert(assigned(Parent));
   assert(TObject(Parent.Data) is TRecordType);
   //for each child
   for i := 0 to TRecordType(Parent.Data).Children.Count - 1 do
    begin
     Child := TRecordType(Parent.Data).Children[i];    //get it
     //add node for the child, and add also its children recusively
     AddChildren(AddNode(Parent, Child.Name, iiClass, Child));
    end;
  end;

 var       //root node for list of all record-like types of this kind
           ByName        :TTreeNode;
           //root node for inheritance trees of record-like types of this kind
           Inherit       :TTreeNode;
           FileNode      :TTreeNode;    //runner through nodes of all files
           Parser        :TPascalFile;  //parsers of all files
           i             :Integer;      //counter through all identifiers
           Rec           :TIdentifier;  //each identifier in all files
 begin
  //create root node for list of record-like types
  ByName := AddNode(nil, RecordKindNames[Kind] + ' by name', iiClasses,
                    TObject(RootIdentIsClass or ord(Kind)));
  if Inheritance then                   //inheritance possible
   //create root node for inheritance trees of record-like types
   Inherit := AddNode(nil, RecordKindNames[Kind] + ' inheritance tree',
                      iiClasses, TObject(RootIdentIsClass or
                                         RootIdentIsClassByInheritance or
                                         ord(Kind)))
  else
   Inherit := nil;                        //no node created

  FileNode := Files.GetFirstChild;      //get node of first file
  while assigned(FileNode) do           //for each file
   begin
    Parser := FileNode.Data;              //get the file
    for i := 0 to Parser.Idents.Count - 1 do //for each identifier in the file
     begin
      Rec := Parser.Idents[i];              //get it
      //is a record-like type of the correct kind?
      if (Rec is TRecordType) and (TRecordType(Rec).Kind = Kind) then
       begin
        AddNode(FileNode, Rec.Name, iiClass, Rec);  //add it to the file

        AddNode(ByName, Rec.Name, iiClass, Rec);    //add it to the list
        //inheritance trees should be created, and is a root of a tree?
        if Inheritance and not assigned(TRecordType(Rec).GetParent()) then
         AddChildren(AddNode(Inherit, Rec.Name, iiClass, Rec));
       end; //if Rec is TRecordType and TRecordType(Rec).Kind = Kind
     end; //for i := 0 to Parser.Idents.Count - 1

    FileNode := FileNode.GetNextSibling;  //next file
   end; //while assigned(FileNode)


  if not ByName.HasChildren then        //no record-like types found and added?
   begin
    TreeView.Items.Delete(ByName);        //delete empty root node
    if Inheritance then          //root node for inheritance trees created?
     TreeView.Items.Delete(Inherit);        //delete it, too
   end; //if not ByName.HasChildren
 end;


var    Files          :TTreeNode;        //root node for list of all files
       i              :Integer;          //counter through each file
       Parser         :TPascalFile;      //each file
begin
 Files := AddNode(nil, 'All Files', iiFiles, nil); //create node for all files

 for i := 0 to FFiles.Count - 1 do       //for each file
  begin
   Parser := FFiles[i];                    //get it
   AddNode(Files, Parser.InternalFileName, iiFile, Parser); //add node for it
  end;

 AddRecordLikes(Files, rkRecord, False); //add all record-like types
 AddRecordLikes(Files, rkObject, False);
 AddRecordLikes(Files, rkClass, True);
 AddRecordLikes(Files, rkInterface, True);
 AddRecordLikes(Files, rkDispInterface, False);

 TreeView.FullExpand;                    //show all nodes
 TreeView.Selected := TreeView.Items.GetFirstNode; //select something
end;

{Returns a root node by the data value.
~param Data the data value the node has to have
~result the root node with the data value }
function TFormDiagram.GetRootByData(Data: Integer): TTreeNode;
begin
 Result := TreeView.Items.GetFirstNode;      //get first root node
 while assigned(Result) and (Result.Data <> Pointer(Data)) do //search node
  Result := Result.GetNextSibling;
end;

{Returns a node under another node by its data.
~param Root the node to search the node under
~param Data the data the node has to have
~result the node with the data value or nil }
function TFormDiagram.FindNodeUnderByData(Root: TTreeNode;
                                          Data: Pointer): TTreeNode;
begin
 Result := nil;                                   //not found so far
 Root := Root.GetFirstChild;                      //get first node
 while assigned(Root) and not assigned(Result) do //while not found
  begin
   if Root.Data = Data then                         //node found?
    Result := Root                                    //return it
   else
    Result := FindNodeUnderByData(Root, Data);        //search under this node

   Root := Root.GetNextSibling;                     //next node
  end;
end;





{Calls the procedure for the class and all its descendants.
~param AddRemove the procedure to call for the classes, either
                 ~[link FDiagram.Add] or ~[link FDiagram.Remove]
~param TheClass  the class to add or remove from the diagram with its
                 descendants
~param TheFile   the file of the class or nil }
procedure TFormDiagram.AddRemoveClassAndDescendants(
                                           AddRemove: THandleAddRemoveDataProc;
                                           TheClass: TRecordType;
                                           TheFile: TPascalFile = nil);
var       i           :Integer;               //counter through all sub-classes
begin
 AddRemove(TheClass, TheFile);                //call the procedure with class