udiagram.pas

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

    //the list of boxes in the diagram
    FBoxes: TBoxList;
    //the size of the whole diagram resulting from the boxes
    FSize: TPoint;

    //the list of modules and containing boxes
    FModules: TStringList;


    //simple value to save if the diagram has been changed
    FDiagramChanged: Boolean;


    //if update is locked, to block expensive and useless repainting of the
    //diagram during multiple operations
    FUpdateLock: Boolean;
    //back-buffer bitmap to first draw the zone to be drawn and then copy it
    FBitmap: TBitmap;
    //back-buffer bitmap to first draw the zoomed view and then copy it
    FZoomBitmap: TBitmap;

    //the width of ~[link MethodBraces] in the current font;
    //just for efficiency
    FMethodBracesWidth: Integer;
    //size of a character in the current font
    FFontSize: TSize;
    //the icons of each possible scope (visibility) of members of a class
    FMemberScopeIcons: TMemberScopeIcons;
    //the maximum width of the icons of each possible scope (visibility) of
    FMemberScopeIconWidth: Integer;       //members of a class


    //bounds of the rectangle containing all selected boxes
    FSelectionBound: TRect;
    //point where the current selection has been started/current position while
    //moving a range of boxes
    FStartSelection: TPoint;
    //current point while selection/moving a range of boxes
    FCurrentSelection: TPoint;
    //if currently some boxes are selected or moved
    //~see FIsMoving
    FIsSelecting: Boolean;
    //if boxes are moved instead of selected;
    //only valid if ~[link FIsSelecting] is True
    FIsMoving: Boolean;




    //event method to be called when the diagram has to be refreshed
    FOnNeedRepaint: TNotifyEvent;
    //event method to be called when the diagram has changed its size
    FOnSizeChanged: TNotifyEvent;



    //Access method to set the value of the update lock ~[link FUpdateLock].
    procedure SetUpdateLock(Value: Boolean);

    //Adds a box with the data to the diagram.
    function InternalAddBox(TheClass: TRecordType; TheFile: TPascalFile): TBox;
    //Removes the box with the index from the diagram.
    procedure RemoveBox(Index: Integer);
    //Calculates the size of the whole diagram resulting from the boxes.
    procedure CalcSize;
    //Checks whether a box is at that position and returns it.
    function FindBox(X, Y: Integer): TBox;
    //Adds all boxes that are at least partly in the given rectangle to the
    //list.
    procedure GetBoxesIn(List: TBoxList; Left, Top, Right, Bottom: Integer);
    //Calculates the bounds of the rectangle containing all selected boxes.
    procedure CalcSelectionBound;

    //Adds the new box to the appropriate module.
    procedure AddBoxToModules(Box: TBox);
    //Removes the box from its module.
    procedure RemoveBoxFromModules(Box: TBox);
    //Clears the list of modules.
    procedure ClearModulesList;
    //Calculates the position to draw the whole diagram to make sure modules
    //are fully visible.
    function AdjustDiagramPositionForModules: TPoint;
    //Draws the modules.
    procedure DrawModules(Drawer: TDiagramDrawer; const Size, Pos: TPoint;
                          Monochrome: Boolean = False);

  public
    //Creates the diagram and initializes it.
    constructor Create;
    //Frees the diagram and all boxes.
    destructor Destroy; override;


    //Clears the diagram to create a new one.
    procedure NewDiagram(IsFileDiagram: Boolean);

    //Returns if the diagram is empty, no boxes are in it.
    function IsEmpty: Boolean;


    //Applies the current options to the diagram.
    procedure ApplyOptions(Changed: Boolean = False);

    //Adds a box with the data to the diagram.
    procedure Add(TheClass: TRecordType; TheFile: TPascalFile);
    //Adds a box with the data to the diagram and sets its position.
    procedure AddWithPosition(TheClass: TRecordType; TheFile: TPascalFile;
                              Position: TPoint);
    //Removes the box depicting the class or file from the diagram.
    procedure Remove(TheClass: TRecordType; TheFile: TPascalFile);

    //Checks whether the file or class is already in the diagram.
    function InDiagram(TheClass: TRecordType; TheFile: TPascalFile): Boolean;
    //Returns the rectangle in the diagram occupied by the box of the data.
    function GetBoxRect(TheClass: TRecordType; TheFile: TPascalFile;
                        var Position: TRect): Boolean;
    //Deleselects all boxes of the diagram.
    procedure DeselectAllBoxes;
    //Calls the call-back function for each box.
    procedure ForEachBox(Func: TForEachBoxRecallFunc;
                         SelectStatus: Booleans = [False, True]);
    //Calls the call-back function for each box with their positions.
    procedure GetBoxPositions(Proc: TForEachGetBoxPositionsRecallProc);

    //Automatically lay-outs the diagram.
    procedure AutoLayOut(LayOut: TDiagramLayOut);


    //Paints a region of the diagram.
    procedure Paint(Canvas: TCanvas; const Rect: TRect; const Pos: TPoint);
    //Draws the whole diagram to the graphic object.
    procedure DrawWholeDiagram(Graphic: TGraphic;
                               const Description: String = '');
    //Saves the whole diagram as an SVG image.
    function DrawWholeDiagramAsSVGFile(const SVGFileName: String;
                                       const Description: String;
                                       LinkKind: TSVGImageLinkKind;
                                       GetLinks: TGetLinkTargetCallBack;
                                       const CharacterEncoding: String):
                                                                        TPoint;
    //Saves the whole diagram as an SVG image.
    function DrawWholeDiagramAsSVGStream(SVGFile: TBufferStream;
                                         const Description: String;
                                         LinkKind: TSVGImageLinkKind;
                                         GetLinks: TGetLinkTargetCallBack;
                                         const CharacterEncoding: String):
                                                                        TPoint;
    //Draws the whole diagram with a custom (external) renderer.
    procedure DrawWholeDiagramWith(Drawer: TExternalDiagramDrawer);
    //Draws a simple map (zoomed view) of the whole diagram.
    procedure PaintZoom(Canvas: TCanvas; const Rect, ViewRect: TRect);


    //Returns the data of the box at the position.
    function GetDataAt(X, Y: Integer; var TheClass: TRecordType;
                       var TheFile: TPascalFile): Boolean;

    //Called when the user starts to select or move boxes.
    procedure StartSelect(X, Y: Integer;
                          ForceSelection, ChangeSelection: Boolean);
    //Called while the user selects or moves boxes.
    procedure MoveSelect(X, Y: Integer);
    //Called when the user has finished to select or move boxes.
    procedure EndSelect(X, Y: Integer; ChangeSelection: Boolean);

    //Returns a HMTL image map with the boxes of the diagram.
    function GetImageMapEntries: String;
    //Returns a list of ~~[imageLink ...] inline commands to be used in an
    //~~[image ] comment for ~[em DelphiDoc] with the boxes of the diagram.
    function GetImageLinks: String;






    property Font: TFont read FFont;
    property IsFileDiagram: Boolean read FIsFileDiagram;

    property ShowAssociations: Boolean read FShowAssociations
                                       write FShowAssociations;
    property ShowFileNameInClass: Boolean read FShowFileNameInClass
                                          write FShowFileNameInClass;
    property ShowScopes: TScopes read FShowScopes write FShowScopes;
    property ShowMembers: TMemberKinds read FShowMembers write FShowMembers;
    property ShowReturnType: Boolean read FShowReturnType
                                     write FShowReturnType;
    property ShowMethodParameters: Boolean read FShowMethodParameters
                                           write FShowMethodParameters;

    property ShowUsingImplementation: Boolean read FShowUsingImplementation
                                              write FShowUsingImplementation;
    property ShowClasses: TRecordKinds read FShowClasses write FShowClasses;
    property ShowClassesNotInInterface: Boolean read FShowClassesNotInInterface
                                              write FShowClassesNotInInterface;
    property ShowModules: Boolean read FShowModules write FShowModules;




    property Margin: Integer read FMargin write FMargin;
    property Size: TPoint read FSize;


    property DiagramChanged: Boolean read FDiagramChanged
                                     write FDiagramChanged;

    property UpdateLock: Boolean read FUpdateLock write SetUpdateLock;



    property MethodBracesWidth: Integer read FMethodBracesWidth;
    property FontSize: TSize read FFontSize;
    property MemberScopeIcons: TMemberScopeIcons read FMemberScopeIcons;
    property MemberScopeIconWidth: Integer read FMemberScopeIconWidth
                                           write FMemberScopeIconWidth;


    property OnNeedRepaint: TNotifyEvent read FOnNeedRepaint
                                         write FOnNeedRepaint;
    property OnSizeChanged: TNotifyEvent read FOnSizeChanged
                                         write FOnSizeChanged;
  end;






  { * * *  ***  * * *  ***   TDiagramLayouter   ***  * * *  ***  * * *  }


  //a class to automatically lay-out diagrams
  TDiagramLayouterClass = class of TDiagramLayouter;

  {The abstract base class to automatically lay-out diagrams. }
  TDiagramLayouter = class
  protected
    //the diagram to automatically lay-out
    FDiagram: TDiagram;
  public
    //Creates the object to layout the diagram.
    constructor Create(Diagram: TDiagram); virtual;


    {Lay-outs the diagram.
    ~param Boxes the boxes in the diagram }
    procedure Execute(Boxes: TBoxList); virtual; abstract;

    property Diagram: TDiagram read FDiagram;
  end;






implementation


uses
{$IFNDEF LINUX}
     Forms,               //to check availability of fonts (in Screen.Fonts)
{$ELSE}
     QForms,              //to check availability of fonts (in Screen.Fonts)
{$ENDIF}
     Math,
     ZLib,    //if you don't have this file installed, search on your Delphi CD
     UFilePaths,          //constant ~[link PathDelimiter]
     UMakeDoc,            //constant ~[link DescFilePreFix]
     UDiagramAutoLayout;





  { * * *  ***  * * *  ***   TCanvasDiagramDrawer   ***  * * *  ***  * * *  }

      //character sequence to start a new line in an XML file
const XMLNewLine = #13#10;

{Draws an arrow.
~param Src             the start point of the arrow
~param Dest            the end point of the arrow
~param Arr1, Arr2      the end points of the arrow head
~param FilledArrowHead whether the arrow head should be filled
~param ThickLine       whether the arrow should be painted thickly
~param LineStyle       the style of the line, either psSolid, psDash or
                       psDashDot }
procedure TCanvasDiagramDrawer.DrawArrow(Src, Dest, Arr1, Arr2: TPoint;
                                         FilledArrowHead: Boolean;
                                         ThickLine: Boolean;
                                         LineStyle: TPenStyle);
begin
 if ThickLine then                       //thicker arrow?
  FCanvas.Pen.Width := 3;                  //draw the line thicker
 FCanvas.Pen.Style := LineStyle;

 FCanvas.Polyline([Src, Dest]);          //draw arrow (main line)

 FCanvas.Pen.Style := psSolid;           //restore to full lines

 if ThickLine then                       //thicker arrow?
  FCanvas.Pen.Width := 2;                  //draw arrow head not that big


 if FilledArrowHead then                 //filled arrow head needed?
  FCanvas.Polygon([Arr1, Dest, Arr2])      //draw filled arrow head
 else
  FCanvas.Polyline([Arr1, Dest, Arr2]);    //draw only frame of arrow head

 if ThickLine then                       //was a thicker arrow?
  FCanvas.Pen.Width := 1;                  //reset to normal width
end;

{Draws the rectangle of a module and its name.
~param Left, Top, Right, Bottom the sides of the rectangle of the module
~param Rounding                 by how much the rectangle should be rounded
~param ModuleName               the name of the module to be drawn
~param TextOffset               the offset of the text from the upper left
                                corner
~param Monochrome               whether the diagram is drawn monochrome }