udiagram.pas

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

  { * * *  ***  * * *  ***   TBox   ***  * * *  ***  * * *  }


  {The abstract base class of boxes in the diagram. Boxes have a position and a
   size and a list of associations and can be selected. A box either depicts a
   file (~[link TFileReference]) or a class (~[link TClassReference]), a
   diagram contains only boxes of the same kind. The associations and the basic
   frame of the box and also the frame in the zoom window are drawn in this
   class. }
  TBox = class
  private
    FDiagram: TDiagram;          //the diagram containing the box and options
    FModulePath: String;         //the module of the box
    FPosition: TPoint;           //position of the box
    FSelected: Boolean;          //if the box is currently selected


    //Returns the number of associations of this box.
    function GetAssociationCount: Integer;
    //Returns an association of this box.
    function GetAssociation(Index: Integer): TAssociation;
  protected
    FAssociations: TList;        //list of associations of the box
    //size of the box, will be calculated in the actual classes
    FSize: TPoint;

    //Calculates the module the file is in and sets its property.
    procedure CalcModulePath(ForFile: TPascalFile);

    //Removes the reference to the association.
    procedure RemoveAssociation(Ass: TAssociation);
    //Draws the basic frame of the box and computes the rectangle of the box on
    //the canvas.
    function DrawBase(Drawer: TDiagramDrawer; var DrawRect: TRect;
                      const Pos: TPoint; HideSelection: Boolean): Boolean;

    //Ends the header of the box.
    procedure EndHeader(Drawer: TDiagramDrawer; var DrawRect: TRect);
  public
    //Creates the box and saves the reference to the diagram.
    constructor Create(Diagram: TDiagram);
    //Frees the object and all associations.
    destructor Destroy; override;


    //Moves the box.
    procedure MoveBy(dX, dY: Integer);


    {Updates the box after some options have been changed. }
    procedure ApplyOptions; virtual; abstract;

    //Called to check for associations when another box is added.
    procedure OtherBoxAdded(Box: TBox; CallOpposite: Boolean); virtual;
    //Called to remove associations when a box is removed from the diagram.
    procedure OtherBoxRemoved(Box: TBox); virtual;


    //Returns an association pointing to another box.
    function FirstAssociationTo(Box: TBox): TAssociation;


    //Draws all associations emerging from this box.
    procedure DrawAssociations(Drawer: TDiagramDrawer; const Size, Pos: TPoint;
                               Monochrome: Boolean = False);
    {Draws the box.
    ~param Drawer        the object doing the actual drawing
    ~param Canvas        the canvas to draw the box to or measure sizes in
    ~param Size          the size of the canvas to draw to
    ~param Pos           position of the rectangle in the diagram to draw
    ~param HideSelection if marks of selected boxes shouldn't be drawn
    ~param Monochrome    if it should be drawn monochrome (don't set color) }
    procedure DrawBox(Drawer: TDiagramDrawer; Canvas: TCanvas;
                      const Size, Pos: TPoint;
                      HideSelection: Boolean = False;
                      Monochrome: Boolean = False); virtual; abstract;
    //Draws the contour of the box on the zoomed map.
    procedure DrawZoom(Canvas: TCanvas; X, Y: Double);



    property Diagram: TDiagram read FDiagram;
    property ModulePath: String read FModulePath;
    property Selected: Boolean read FSelected write FSelected;
    property AssociationCount: Integer read GetAssociationCount;
    property Associations[Index: Integer]: TAssociation read GetAssociation;
    property Position: TPoint read FPosition write FPosition;
    property Size: TPoint read FSize;
    property Left: Integer read FPosition.x;
    property Top: Integer read FPosition.y;
    property Width: Integer read FSize.x;
    property Height: Integer read FSize.y;
  end;





  { * * *  ***  * * *  ***   TFileReference   ***  * * *  ***  * * *  }

  {The class to depict files in diagrams. As such it inherits from TBox while
   also keeping a reference to the file to draw it. }
  TFileReference = class(TBox)
  private
    FTheFile: TPascalFile;       //the reference to the file the box depicts

    //Gets all classes to be shown in the box.
    function GetClasses(List: TList): Boolean;
  public
    //Creates the box to depict the given file.
    constructor Create(Diagram: TDiagram; TheFile: TPascalFile);

    //Calculates the size of the box when using the current options.
    procedure ApplyOptions; override;

    //Adds an association if the other file is used by this one.
    procedure OtherBoxAdded(Box: TBox; CallOpposite: Boolean); override;

    //Draws this box, i.e. the name of the file and maybe contained types.
    procedure DrawBox(Drawer: TDiagramDrawer; Canvas: TCanvas;
                      const Size, Pos: TPoint; HideSelection: Boolean = False;
                      Monochrome: Boolean = False); override;


    property TheFile: TPascalFile read FTheFile;
  end;




  { * * *  ***  * * *  ***   TClassReference   ***  * * *  ***  * * *  }

  {The class to depict classes in diagrams. As such it inherits from TBox while
   also keeping a reference to the class to draw it and its selected members. }
  TClassReference = class(TBox)
  private
    FTheClass: TRecordType;      //the reference to the class the box depicts

    //Returns members in this class of the kind and a correct visibility.
    function GetIdents(List: TIdentifierList;
                       SearchedClass: TIdentifierClass): Boolean;
    //Checks whether the type is a searched class;
    //type: ~[link TForEachIdentTypeProc]
    procedure CheckAssociation(Ident: TIdentType; Parent: TIdentifier;
                               TheClass: TIdentifier);
  public
    //Creates the box to depict the given class.
    constructor Create(Diagram: TDiagram; TheClass: TRecordType);



    //Creates the icons for the different visibilities using the current
    //options.
    class procedure StaticApplyOptions(Diagram: TDiagram);


    //Calculates the size of the box when using the current options.
    procedure ApplyOptions; override;

    //Checks if there is an association between the new class and this one of
    //any kind and adds it.
    procedure OtherBoxAdded(Box: TBox; CallOpposite: Boolean); override;

    //Draws this box with the name of the class and all not filtered members.
    procedure DrawBox(Drawer: TDiagramDrawer; Canvas: TCanvas;
                      const Size, Pos: TPoint; HideSelection: Boolean = False;
                      Monochrome: Boolean = False); override;


    property TheClass: TRecordType read FTheClass;
  end;








{$DEFINE ListTemplateItemIsObject}
{$DEFINE ListTemplateItemMayBeFreed}
{$DEFINE ListTemplateItemFreedByDefault}
{$DEFINE ListTemplateUseIndexOf}

  //the items for the template list to use
  TListTemplateListItem = TBox;

{$INCLUDE ..\General\Templates\ListTemplate.inc}

  {A list of boxes in the diagram. }
  TBoxList

{$INCLUDE ..\General\Templates\ListTemplate.inc}

  //alias for the list to be used by the implementations of the methods
  TListTemplate = TBoxList;





  { * * *  ***  * * *  ***   TDiagram   ***  * * *  ***  * * *  }


  //the icons of each possible scopes (visibility) of members of a class
  TMemberScopeIcons = array[TMemberScopes] of TBitmap;


  //how to lay-out the diagram
  TDiagramLayOut = (
                    dloSugiyama,           //use the algorithm of Sugiyama
                    dloSimple,             //use a simple layout
                    //simple layout with post-optimizing
                    dloSimplePostProcess); //(class layout only)

  //the exception to be thrown if automatic lay-outing fails
  ELayOutException = class(Exception);



  //a set of boolean values, used to filter in ~[link TDiagram.ForEachBox]
  Booleans = set of Boolean;

  //action to take while enumerating boxes via ~[link TDiagram.ForEachBox]
  TBoxEnumerationAction = (
                           beaAbort,           //abort the enumeration
                           beaRemoveBox,       //remove box from the diagram
                           //change the selection state of the box, state
                           //depends on ~[link beaIsSelected] being also in the
                           beaChangeSelection, //result set
                           //if the box should be selected, else deselected
                           //(only if also ~[link beaChangeSelection] is
                           beaIsSelected);     //included)

  //a set of actions to take while enumerating boxes via
  //~[link TDiagram.ForEachBox]
  TBoxEnumerationActions = set of TBoxEnumerationAction;


  {recall method to enumerate through all boxes via
   ~[link TDiagram.ForEachBox]
  ~param TheClass the class of the box, if it is not a file diagram
  ~param TheFile  the file of the box, or the file of the class
  ~param Selected if the box is selected
  ~result what actions to take on the box or the enumeration }
  TForEachBoxRecallFunc = function (TheClass: TRecordType;
                                    TheFile: TPascalFile;
                                    Selected: Boolean): TBoxEnumerationActions
                                    of object;

  {recall method to get the position of each box via
   ~[link TDiagram.GetBoxPositions]
  ~param TheClass the class of the box, if it is not a file diagram
  ~param TheFile  the file of the box, or the file of the class
  ~param Position the position of the box
  ~param Size     the size of the box }
  TForEachGetBoxPositionsRecallProc = procedure (TheClass: TRecordType;
                                                 TheFile: TPascalFile;
                                                 Position,
                                                 Size: TPoint) of object;


  {A method that either adds or removes a box with the data to/from the
   diagram, for instance ~[link TDiagram.Add] and ~[link TDiagram.Remove].
  ~param TheClass the class to add or remove or nil if it is a diagram of files
  ~param TheFile  the file of the class to add or remove or the file itself }
  THandleAddRemoveDataProc = procedure (TheClass: TRecordType;
                                        TheFile: TPascalFile) of object;


  {Called to calculate the (relative) URI of the documentation (or something
   similar) of the specified class or file, to be used as a link on the box of
   in the diagram.
  ~param TheClass the class to calculate the URI of, if not nil
  ~param TheFile  the file to calculate the URI of, if not nil
  ~result the URI to the documentation of the class or file or '' if none
          available }
  TGetLinkTargetCallBack = function (TheClass: TRecordType;
                                     TheFile: TPascalFile): String of object;


  {This class manages all options and all boxes of a diagram and its painting.
   It's the only class to be used outside this unit to create diagrams of
   classes or files. }
  TDiagram = class
  private
    //font to use when drawing the diagram; do not use the default
    //'MS Sans Serif', use a True Type font instead, like Arial, so it can be
    //scaled to any font size
    FFont: TFont;

    //if it is a diagram of files instead of classes
    FIsFileDiagram: Boolean;


    //if simple associations (using one class in another) should be shown
    FShowAssociations: Boolean;
    //if the names of the files the classes are defined in should also be shown
    FShowFileNameInClass: Boolean;
    //the set of scopes of members of the classes to list
    FShowScopes: TScopes;
    //the set of kinds of members of the classes to list
    FShowMembers: TMemberKinds;
    //if the return type of functions should be shown
    FShowReturnType: Boolean;
    //if the parameters and return type of methods should be shown
    FShowMethodParameters: Boolean;


    //if the associations of units used by other units in the implementation
    //part should be shown
    FShowUsingImplementation: Boolean;
    //the set of kinds of record-likes types in files to be shown
    FShowClasses: TRecordKinds;
    //if classes not in the interface of units should be shown
    FShowClassesNotInInterface: Boolean;

    //whether the modules (directory) of files/classes should be shown
    FShowModules: Boolean;


    //margin used in the boxes and for other purposes
    FMargin: Integer;