uvectorgraphics.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit UVectorGraphics;

{Contains functions to write the list of files with their dependance among each
 other and the inheritance trees of classes. These files can be written in
 three different graphic formats, SVG (Scalable Vector Graphics),
 EMF (Enhanced Windows Meta Files) and XFig (Figures, used mainly under the
 X Window System under Unix). All these graphic formats are not raster graphics
 like Bitmap, JPEG or PNG, but are vector graphics, that means they are freely
 scalable and even though the dimensions of the resulting images may be huge,
 the size of the files will be pretty small compared to raster graphic formats.
}


interface

uses Classes,
     UBaseIdents;




//Writes an EMF file of all files and their dependance among each other.
procedure WriteFileEMF(FFiles: TFileList; const FileName: String);
//Writes an EMF file of all classes of that kind and their inheritance from
//each other.
procedure WriteClassesEMFTree(TopLevelClasses: TStrings;
                              const FileName: String);





     {Called to calculate the (relative) URI of the documentation (or something
      similar) of the specified file, to be used as a link on the box of the
      file in the simple diagram.
     ~param AFile the file to calculate the URI of
     ~result the URI to the documentation of the file or '' }
type TGetFileURLCallBack = function (AFile: TPascalFile): String of object;

     {Called to calculate the (relative) URI of the documentation (or something
      similar) of the specified record-like type, to be used as a link on the
      box of the type in the diagram.
     ~param AClass the record-like type to calculate the URI of
     ~result the URI to the documentation of the record-like type or '' }
     TGetClassURLCallBack = function (AClass: TRecordType): String of object;

//Writes an SVG file of all classes of that kind and their inheritance from
//each other.
procedure WriteClassesSVGTree(TopLevelClasses: TStrings;
                              const FileName: String;
                              URLCallBack: TGetClassURLCallBack);
//Writes an SVG file of all files and their dependance among each other.
procedure WriteFileSVG(FFiles: TFileList; const FileName: String;
                       URLCallBack: TGetFileURLCallBack);




//Writes an XFig file of all files and their dependance among each other.
procedure WriteFileXFigure(FFiles: TFileList; const FileName: String);
//Writes an XFig file of all classes of that kind and their inheritance from
//each other.
procedure WriteClassesXFigureTree(TopLevelClasses: TStrings;
                                  const FileName: String);




implementation


uses Windows, SysUtils, Graphics,
     General,
     UPascalConsts;


     //a pointer on a file/list of files
     //(the code should probably be changed to use dynamic arrays instead)
type PPascalFile = ^TPascalFile;


      //new line sequence to be used in XML files (i.e. SVG files)
const XMLNewLine = #13#10;
      //size of the font in pixels
      SVGFontName =
{$IFNDEF Linux}
                    'Verdana';
{$ELSE}
                    'Helvetica';
{$ENDIF}
      //size of the font in pixels
      SVGFontSize = 10;
      //the number of pixels to round the edges of rectangles with strings in
      //by
      RoundRectRadix = 5;



{$IFNDEF LINUX}

//Draws a string and a rectangle behind it into an EMF file.
procedure EMFDrawBoxedString(Canvas: TCanvas; const Name: String;
                             X, Y: Integer; BoxSize: TSize); forward;
//Draws an arrow inside an EMF file.
procedure EMFDrawArrow(Canvas: TCanvas; Src, Dest, Arr1, Arr2: TPoint;
                       BoldArrow: Boolean); forward;
//Draws a line in an EMF file.
procedure EMFDrawLine(Canvas: TCanvas;
                      Xs, Ys, Xe, Ye: Integer); forward;

{$ENDIF}


//Starts a SVG file by writing its document type and so on.
procedure SVGStartFile(SVGFile: TBufferStream; const Title: String;
                       ImageWidth, ImageHeight: Integer;
                       CanContainLinks: Boolean); forward;
//Ends a SVG file by closing any tags opened in ~[link SVGStartFile].
procedure SVGEndFile(SVGFile: TBufferStream); forward;
//Draws a string and a rectangle behind it into an SVG file.
procedure SVGDrawBoxedString(SVGFile: TBufferStream; const Name: String;
                             X, Y: Integer; BoxSize: TSize;
                             const LinkTarget: String); forward;
//Draws an arrow inside an SVG file.
procedure SVGDrawArrow(SVGFile: TBufferStream; Src, Dest, Arr1, Arr2: TPoint;
                       BoldArrow: Boolean); forward;
//Draws a line in an SVG file.
procedure SVGDrawLine(SVGFile: TBufferStream;
                      Xs, Ys, Xe, Ye: Integer); forward;






type
  {Abstract base class to draw diagrams in different formats. An implementation
   for Enhanced Windows Meta files another for Scalable Vector Graphics
   exists.}
  TVectorFormatHandler = class
  protected
    //the name of the file as which the diagram should be saved
    FFileName: String;
  public
    //Creates the object and saves the name of the file.
    constructor Create(const FileName: String);

    //Sets the link target for the next box to be drawn.
    procedure SetNextTextBoxesLinkTarget(const Target: String); virtual;

    {Called before ~[link GetTextExtent] is called to allow the set-up for the
     measurement. GetTextExtent may be called several times. }
    procedure PrepareTextMeasuring; virtual; abstract;
    {Measures the size of a text in the diagram in the format.
    ~param Text the text whose size should be measured
    ~result the size of the text }
    function GetTextExtent(const Text: String): TSize; virtual; abstract;
    {Called after ~[link GetTextExtent] has been called (multiple times) to
     allow the tear down after the measurement. It is ensured that this method
     will be called after a call to ~[link PrepareTextMeasuring]. }
    procedure EndTextMeasuring; virtual; abstract;
    {Called before the actual image is being drawn.
    ~param ImageWidth, ImageHeight the dimensions of the image of the diagram
    ~param ImageTitle              the title of the diagram and image }
    procedure InitImageObjects(ImageWidth, ImageHeight: Integer;
                               const ImageTitle: String); virtual; abstract;
    {Called after the actual image has been drawn. It is ensured that this
     method will be called after a call to ~[link InitImageObjects]. }
    procedure FinalizeImageObjects; virtual; abstract;

    {Draws a text and a rectangle behind it.
    ~param Text    the text to be written in a box
    ~param X,Y     the position to draw it at
    ~param BoxSize the size of the rectangle behind the text }
    procedure DrawBoxedText(const Text: String; X, Y: Integer; BoxSize: TSize);
                                                             virtual; abstract;
    {Draws an arrow.
    ~param Src        the starting point of the arrow
    ~param Dest       the ending point of the arrow
    ~param Arr1, Arr2 the positions of both sides of the head of the arrow
    ~param BoldArrow  whether the arrow should be "bold", the head filled }
    procedure DrawArrow(Src, Dest, Arr1, Arr2: TPoint; BoldArrow: Boolean);
                                                             virtual; abstract;
    {Draws a line.
    ~param Xs, Ys starting position of the line
    ~param Xe, Ye end point of the line }
    procedure DrawLine(Xs, Ys, Xe, Ye: Integer); virtual; abstract;
  end;




  {Draws a diagram of all files and their inter-dependance among each other. }
  TVectorFileDrawer = class
  protected
    //the list of files whose inter-dependace should be drawn
    FFiles: TFileList;
    //the object used to do the actual drawing in a selected image format
    FFormatHandler: TVectorFormatHandler;
    //method pointer to get the target of links for each file
    FURLCallBack: TGetFileURLCallBack;

    //the (calculated) size of all the boxes of files in the diagram
    FBoxSize: TSize;


    //Calculates the size of all the boxes of files in the diagram.
    function CalculateBoxSize: TSize;

    //Draws all files on the image.
    procedure DrawFiles;
  public
    //Creates the drawer of diagrams and saves the parameters.
    constructor Create(Files: TFileList; FormatHandler: TVectorFormatHandler;
                       URLCallBack: TGetFileURLCallBack);
    //Frees the drawer of diagrams and the drawing object.
    destructor Destroy; override;

    //Draws the whole diagram and saves it into a file.
    procedure DrawFile;
  end;



  //the different states while drawing the diagram of all classes and their
  //inheritance from each other
  TClassDrawState = (
                     cdsCalculate,  //calculating positions of each class
                     cdsLines,      //drawing lines/arrow between the classes
                     cdsBoxes);     //drawing the classes themselves

  {Draws a diagram of all classes of that kind and their inheritance from each
   other. }
  TVectorClassDrawer = class
  protected
    //the tree of classes as the list of classes with no parent or that are
    //unknown and each entry containing the list of childrens recursively
    FTopLevelClasses: TStrings;
    //the object used to do the actual drawing in a selected image format
    FFormatHandler: TVectorFormatHandler;
    //method pointer to get the target of links for each class
    FURLCallBack: TGetClassURLCallBack;

    //the (calculated) size of the whole image
    FCanvasSize: TSize;
    //the (calculated) size of all the boxes of classes in the diagram
    FBoxSize: TSize;

    //maximum depth in figure
    FMaxDepth: Integer;


    //Calculates the size of all the boxes of classes in the diagram.
    function CalculateBoxSize: TSize;
    //Draws the classes, the arrows between them or calculates the position of
    //the boxes depending on the specified state.
    function CalcDraw(Draw: TClassDrawState): Integer;
    //Draws a list of classes on the same level, inheriting from the same
    //parent class (or having no (known) parent class). All their descendants
    //are also drawn as a (sub-)tree.
    procedure DrawFigureTree(Draw: TClassDrawState; List: TIdentifierList;
                             var XPos: Integer; YPos: Integer; Depth: Integer;
                             CoordsBackToParent: PPoint);
  public
    //Creates the drawer of diagrams and saves the parameters.
    constructor Create(TopLevelClasses: TStrings;
                       FormatHandler: TVectorFormatHandler;
                       URLCallBack: TGetClassURLCallBack);
    //Frees the drawer of diagrams and the drawing object.
    destructor Destroy; override;

    //Draws the whole diagram and saves it into a file.
    procedure DrawFile;
  end;





{$IFNDEF LINUX}

  {Is used to draw and save diagrams as Enhanced Windows Meta files. }
  TEMFFormatHandler = class(TVectorFormatHandler)
  private
    //the meta file to draw the diagram on
    FMetafile: TMetafile;
    //the canvas of a meta file to draw the diagram on
    FCanvas: TMetaFileCanvas;
  public
    //Creates the object and the meta file object.
    constructor Create(const FileName: String);
    //Frees the object and the meta file object.
    destructor Destroy; override;

    //Called before ~[link GetTextExtent] is called to allow the set-up for the
    //measurement. GetTextExtent may be called several times.
    procedure PrepareTextMeasuring; override;
    //Measures the size of a text in the diagram in the format.
    function GetTextExtent(const Text: String): TSize; override;
    //Called after ~[link GetTextExtent] has been called to allow the tear down
    //after the measurement.
    procedure EndTextMeasuring; override;
    //Called before the actual image is being drawn.
    procedure InitImageObjects(ImageWidth, ImageHeight: Integer;
                               const ImageTitle: String); override;
    //Called after the actual image has been drawn.
    procedure FinalizeImageObjects; override;

    //Draws a text and a rectangle behind it.
    procedure DrawBoxedText(const Text: String; X, Y: Integer; BoxSize: TSize);
                                                                      override;
    //Draws an arrow.
    procedure DrawArrow(Src, Dest, Arr1, Arr2: TPoint; BoldArrow: Boolean);
                                                                      override;
    //Draws a line.
    procedure DrawLine(Xs, Ys, Xe, Ye: Integer); override;
  end;

{$ENDIF}

  {Is used to draw and save diagrams as Scalable Vector Graphics files. }
  TSVGFormatHandler = class(TVectorFormatHandler)
  private
    //the stream to write the diagram into the SVG file
    FSVGFile: TBufferStream;
    //whether links may be inserted into the image
    FCanContainLinks: Boolean;
    //the bitmap used to measure the size of texts
    FMeasureBMP: TBitmap;
    //the link target to be used for a link on the next box, "" for no link
    FNextLinkTarget: String;
  public
    //Creates the object, opens the SVG file and saves whether it can contain
    //links.