updfgraphics.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) 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 UPDFGraphics;

{Contains a few functions to draw in a PDF file and mainly the class
 ~[link TPDFDiagramDrawer] which draws a ~[link TDiagram diagram] in a PDF page
 directly via PDF commands.
}


interface

uses Windows, Classes,
{$IFNDEF LINUX}
     Graphics,
{$ELSE}
     QGraphics,
{$ENDIF}
     UPascalConsts,
     UDiagram,
     UPDFWriter, UPDFTextWriter;



const


  {the ratio of the radius of a circle to the distances of the (cubic) B閦ier
   control points when drawing a circle with four B閦ier curves, one for each
   quarter of a circle, it is the result of the calculcation
   ~[code (Sqrt(2) - 1) * 4 / 3]
  ~example the path of a circle in PDF, positioned at 200,100 with radius 60,
           mind that all numbers with a fraction part are either the the radius
           multiplied with this constant (results to 33.12) added or subtracted
           from the position of one of the sides:
   ~[preformatted
   260.00 100.00 m                              % right edge of the circle
   260.00 133.12 233.12 160.00 200.00 160.00 c  % to the upper edge
   166.88 160.00 140.00 133.12 140.00 100.00 c  % to the left edge
   140.00  66.88 166.88  40.00 200.00  40.00 c  % to the bottom edge
   233.12  40.00 260.00  66.88 260.00 100.00 c  % to the right edge egain
   ]
  }
  CircleBezierPointDistanceFactor = 0.552284749830793398402251632279597;


//Draws a line on the current page of the PDF file.
procedure DrawPDFLine(Writer: TPDFWriter; FromX, FromY, ToX, ToY: TPDFValue);

//Draws a circle on the current page of the PDF file.
procedure DrawPDFCircle(Writer: TPDFWriter; X, Y, Radius: TPDFValue);

//Draws a rounded rectangle on the current page of the PDF file.
procedure DrawPDFRoundRect(Writer: TPDFWriter;
                           Left, Top, Right, Bottom, Radius: TPDFValue);






type
  { * * *  ***  * * *  ***   TPDFDiagramDrawer   ***  * * *  ***  * * *  }

  {A call-back function to obtain the scaling factor for diagrams to be drawn.
  ~param Size the size of the diagram to be scaled
  ~result the scaling factor }
  TGetImageScaleCallBack = function (Size: TPoint): Single of object;

  {Used to draw the diagram in a PDF file. }
  TPDFDiagramDrawer = class(TExternalDiagramDrawer)
  private
    //the writer used to write the diagram in the PDF file
    FWriter: TPDFWriter;
    //the text writer managing the positions and pages in the PDF file
    FTextWriter: TPDFTextWriter;

    //used to obtain the scaling factor for the diagram,
    //1.0 will be used if unassigned, which might lead to the diagram being
    //partly not visible
    FScaleCallBack: TGetImageScaleCallBack;

    //the size of the diagram in pixels
    FDiagramSize: TPoint;
    //the scaling factor for the diagram
    FImageScale: Single;
    //the offset from the top of a text to the base line
    FOffset: TPDFPoint;
    //the size of the diagram in point, the PDF internal unit
    FSize: TPDFPoint;

    //offset of the base line from the top line for the font
    FBaseLineOffset: TPDFValue;

    //handle of the font before drawing the diagram
    FFontHandle: Integer;

    //whether currently in text mode
    FInText: Boolean;

    //Sets the text mode.
    procedure SetTextMode(InText: Boolean);
  public
    //Allows the object to initialize itself with the size of the diagram.
    procedure Initialize(Size: TPoint; FontHeight: Integer); override;
    //Allows the object to finish drawing the diagram and clean up.
    procedure Finish;


    //Draws an arrow.
    procedure DrawArrow(Src, Dest, Arr1, Arr2: TPoint;
                        FilledArrowHead: Boolean; ThickLine: Boolean;
                        LineStyle: TPenStyle); override;
    //Draws the rectangle of a module and its name.
    procedure DrawModule(Left, Top, Right, Bottom: Integer; Rounding: Integer;
                         const ModuleName: String; TextOffset: Integer;
                         Monochrome: Boolean); override;
    //Draws a box of a file or class in the diagram.
    procedure DrawBox(Left, Top, Right, Bottom: Integer;
                      Rounding: Integer); override;
    //Draws selection markers at a box of a file or class in the diagram.
    procedure DrawBoxSelection(Left, Top, Right, Bottom: Integer;
                               HalfSize: Integer); override;
    //Draws some text.
    procedure DrawText(Top, Left, Right: Integer; const Text: String;
                       Center: Boolean; Style: TFontStyles;
                       Color: TColor); override;
    //Draws a line.
    procedure DrawLine(Xs, Ys, Xe, Ye: Integer); override;
    //Draws an icon representing a scope of a member of a record-like type.
    procedure DrawScopeIcon(X, Y: Integer; Scope: TScope); override;


    property Writer: TPDFWriter read FWriter write FWriter;
    property TextWriter: TPDFTextWriter read FTextWriter write FTextWriter;
    property ScaleCallBack: TGetImageScaleCallBack read FScaleCallBack
                                                   write FScaleCallBack;

    property DiagramSize: TPoint read FDiagramSize write FDiagramSize;
    property Offset: TPDFPoint read FOffset write FOffset;
    property Size: TPDFPoint read FSize write FSize;
  end;








implementation

//Gets the parameters for a rg or RG command to set the stroke or fill color.
function GetPDFColorParameters(Color: TColor): String; forward;
//Gets the commands to draw a line in a PDF file.
function GetPDFCommandStrokedLine(FromX, FromY,
                                  ToX, ToY: TPDFValue): String; forward;
//Gets the commands to draw a circle in a PDF file.
function GetPDFCommandCirclePath(X, Y, Radius: TPDFValue): String; forward;
//Gets the commands to draw a rounded rectangle in a PDF file.
function GetPDFCommandRoundedRectanglePath(Left, Top,
                                           Right, Bottom, Radius: TPDFValue;
                                           CloseRectangle: Boolean): String;
                                                                       forward;




{Gets the parameters for a rg or RG command to set the stroke or fill color.
~param Color the color to be set
~result the color's RGB values in the range 0..1 }
function GetPDFColorParameters(Color: TColor): String;
begin
 Result := //extract each RGB-component and add it transformed to 0..1
           PDFNumberToStr((Color and $FF) / 255) + ' ' +
           PDFNumberToStr(((Color shr 8) and $FF) / 255) + ' ' +
           PDFNumberToStr(((Color shr 16) and $FF) / 255);
end;

{Gets the commands to draw a line in a PDF file.
~param FromX, FromY the starting point of the line
~param ToX, ToY     the end point of the line
~result the commands to draw the line }
function GetPDFCommandStrokedLine(FromX, FromY, ToX, ToY: TPDFValue): String;
begin
 Result := //set command to draw the line
           PDFNumberToStr(FromX) + ' ' +     //move to starting point
           PDFNumberToStr(FromY) + ' m' + UPDFWriter.NewLine +
           PDFNumberToStr(ToX) + ' ' +       //draw line to ending point
           PDFNumberToStr(ToY) + ' l' + UPDFWriter.NewLine +
           'S' + UPDFWriter.NewLine;         //and draw this line
end;

{Gets the commands to draw a circle in a PDF file.
~param X, Y   the position of the center of the circle
~param Radius the radius of the circle
~result the commands to draw the circle }
function GetPDFCommandCirclePath(X, Y, Radius: TPDFValue): String;
         //the distance of the control points from the sides of the circle
var      ControlDist       :TPDFValue;
begin
 ControlDist := Radius * CircleBezierPointDistanceFactor;
 Result :=
           //go to starting point of circle, its right side
           PDFNumberToStr(X + Radius) + ' ' + PDFNumberToStr(Y) + ' m' +
           UPDFWriter.NewLine +
           //draw upper right quarter of the circle (to its upper side)
           PDFNumberToStr(X + Radius) + ' ' +
           PDFNumberToStr(Y + ControlDist) + ' ' +
           PDFNumberToStr(X + ControlDist) + ' ' +
           PDFNumberToStr(Y + Radius) + ' ' +
           PDFNumberToStr(X) + ' ' +
           PDFNumberToStr(Y + Radius) + ' c' + UPDFWriter.NewLine +
           //draw upper left quarter of the circle (to its left side)
           PDFNumberToStr(X - ControlDist) + ' ' +
           PDFNumberToStr(Y + Radius) + ' ' +
           PDFNumberToStr(X - Radius) + ' ' +
           PDFNumberToStr(Y + ControlDist) + ' ' +
           PDFNumberToStr(X - Radius) + ' ' +
           PDFNumberToStr(Y) + ' c' + UPDFWriter.NewLine +
           //draw lower left quarter of the circle (to its bottom side)
           PDFNumberToStr(X - Radius) + ' ' +
           PDFNumberToStr(Y - ControlDist) + ' ' +
           PDFNumberToStr(X - ControlDist) + ' ' +
           PDFNumberToStr(Y - Radius) + ' ' +
           PDFNumberToStr(X) + ' ' +
           PDFNumberToStr(Y - Radius) + ' c' + UPDFWriter.NewLine +
           //draw lower right quarter of the circle (to its right side again)
           PDFNumberToStr(X + ControlDist) + ' ' +
           PDFNumberToStr(Y - Radius) + ' ' +
           PDFNumberToStr(X + Radius) + ' ' +
           PDFNumberToStr(Y - ControlDist) + ' ' +
           PDFNumberToStr(X + Radius) + ' ' +
           PDFNumberToStr(Y) + ' c' + UPDFWriter.NewLine;
end;

{Gets the commands to draw a rounded rectangle in a PDF file.
~param Left, Top      the position of the upper left corner of the rectangle
~param Right, Bottom  the position of the lower right corner of the rectangle
~param Radius         the radius of the circle to be used to round the corners
                      of the rectangles, has to be smaller than half of the
                      lengths of both sides of the rectangle
~param CloseRectangle if this is not set, the rectangle will not be closed,
                      i.e. its right edge is missing, this will automatically
                      be closed when drawing it with the right operator
~result the commands to draw the rounded rectangle }
function GetPDFCommandRoundedRectanglePath(Left, Top,
                                           Right, Bottom, Radius: TPDFValue;
                                           CloseRectangle: Boolean): String;
         //reversed control distance, the distance of the control points from
         //the corners of the rectangle
var      RevControl   :TPDFValue;