updfgraphics.pas

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

begin
 Assert(Radius <= (Right - Left) / 2);
 Assert(Radius <= (Top - Bottom) / 2);

 //calculate offset of the control points
 RevControl := Radius * (1 - CircleBezierPointDistanceFactor);

 Result :=
           //go to starting point of rectangle, right upper corner
           PDFNumberToStr(Right) + ' ' +
           PDFNumberToStr(Top - Radius) + ' m' + UPDFWriter.NewLine +
           //draw upper right round corner of the rectangle
           PDFNumberToStr(Right) + ' ' +
           PDFNumberToStr(Top - RevControl) + ' ' +
           PDFNumberToStr(Right - RevControl) + ' ' +
           PDFNumberToStr(Top) + ' ' +
           PDFNumberToStr(Right - Radius) + ' ' +
           PDFNumberToStr(Top) + ' c' + UPDFWriter.NewLine +
           //draw upper edge of the rectangle
           PDFNumberToStr(Left + Radius) + ' ' +
           PDFNumberToStr(Top) + ' l' + UPDFWriter.NewLine +
           //draw upper left round corner of the rectangle
           PDFNumberToStr(Left + RevControl) + ' ' +
           PDFNumberToStr(Top) + ' ' +
           PDFNumberToStr(Left) + ' ' +
           PDFNumberToStr(Top - RevControl) + ' ' +
           PDFNumberToStr(Left) + ' ' +
           PDFNumberToStr(Top - Radius) + ' c' + UPDFWriter.NewLine +
           //draw left edge of the rectangle
           PDFNumberToStr(Left) + ' ' +
           PDFNumberToStr(Bottom + Radius) + ' l' + UPDFWriter.NewLine +
           //draw lower left round corner of the rectangle
           PDFNumberToStr(Left) + ' ' +
           PDFNumberToStr(Bottom + RevControl) + ' ' +
           PDFNumberToStr(Left + RevControl) + ' ' +
           PDFNumberToStr(Bottom) + ' ' +
           PDFNumberToStr(Left + Radius) + ' ' +
           PDFNumberToStr(Bottom) + ' c' + UPDFWriter.NewLine +
           //draw bottom edge of the rectangle
           PDFNumberToStr(Right - Radius) + ' ' +
           PDFNumberToStr(Bottom) + ' l' + UPDFWriter.NewLine +
           //draw lower right round corner of the rectangle
           PDFNumberToStr(Right - RevControl) + ' ' +
           PDFNumberToStr(Bottom) + ' ' +
           PDFNumberToStr(Right) + ' ' +
           PDFNumberToStr(Bottom + RevControl) + ' ' +
           PDFNumberToStr(Right) + ' ' +
           PDFNumberToStr(Bottom + Radius) + ' c' + UPDFWriter.NewLine;

 //if the rectangle should be closed explicitely, draw the last line
 if CloseRectangle then
  Result := Result + PDFNumberToStr(Right) + ' ' +
                     PDFNumberToStr(Top - Radius) + ' l' + UPDFWriter.NewLine;
end;













{Draws a line on the current page of the PDF file.
~param Writer       the writer of the PDF file to draw the line with
~param FromX, FromY the starting point of the line
~param ToX, ToY     the end point of the line }
procedure DrawPDFLine(Writer: TPDFWriter; FromX, FromY, ToX, ToY: TPDFValue);
begin
 //get the commands to draw the line and add it to the page
 Writer.AddLowLevelDrawingCommandsToPage(GetPDFCommandStrokedLine(FromX, FromY,
                                                                  ToX, ToY));
end;

{Draws a circle on the current page of the PDF file.
~param Writer the writer of the PDF file to draw the line with
~param X, Y   the position of the center of the circle
~param Radius the radius of the circle }
procedure DrawPDFCircle(Writer: TPDFWriter; X, Y, Radius: TPDFValue);
var       Commands     :String;        //the commands to draw the shape
begin
 //get the commands to draw the circle
 Commands :=
             //set width of the border
             //PDFNumberToStr(LineWidth) + ' c' + UPDFWriter.NewLine +

             //set color for the border of the circle
             //GetPDFColorParameters(Color) + ' RG' + UPDFWriter.NewLine +

             //set color of the circle
             //GetPDFColorParameters(Color) + ' rg' + UPDFWriter.NewLine +

             GetPDFCommandCirclePath(X, Y, Radius) +

             //close (h) and stroke (S) the path of the circle
             's' + UPDFWriter.NewLine;

             //close (h), fill (f) and stroke (S) [the path of] the circle
//             'b' + UPDFWriter.NewLine;

 //add the commands to the page
 Writer.AddLowLevelDrawingCommandsToPage(Commands);
end;

{Draws a rounded rectangle on the current page of the PDF file.
~param Writer         the writer of the PDF file to draw the line with
~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 }
procedure DrawPDFRoundRect(Writer: TPDFWriter;
                           Left, Top, Right, Bottom, Radius: TPDFValue);
var       OldColor        :TColor;     //saves the current color
          Commands        :String;     //the commands to draw the shape
begin
 OldColor := Writer.Color;             //save the current color
 Writer.SetColor(clWhite);             //draw a white circle

 //get the commands to draw the rounded rectangle
 Commands :=

// 'ET' + UPDFWriter.NewLine +


             //set width of the border
             //PDFNumberToStr(LineWidth) + ' c' + UPDFWriter.NewLine +

//             '0 0 0 RG' + UPDFWriter.NewLine +
//             '.9 .9 .9 rg' + UPDFWriter.NewLine +

             //set color for the border of the circle
             //PDFNumberToStr((Color and $FF) / 255) + ' ' +
             //PDFNumberToStr(((Color shr 8) and $FF) / 255) + ' ' +
             //PDFNumberToStr(((Color shr 16) and $FF) / 255) + ' RG' +
             //UPDFWriter.NewLine +

             //set color of the circle
             //PDFNumberToStr((Color and $FF) / 255) + ' ' +
             //PDFNumberToStr(((Color shr 8) and $FF) / 255) + ' ' +
             //PDFNumberToStr(((Color shr 16) and $FF) / 255) + ' rg' +
             //UPDFWriter.NewLine +


             //set path of the rectangle, the right edge of the rectangle will
             //be drawn automatically when closing the path
             GetPDFCommandRoundedRectanglePath(Left, Top, Right, Bottom,
                                               Radius, False) +

             //close (h) and stroke (S) the path of the rounded rectangle
//             's' + UPDFWriter.NewLine;

             //close (h), fill (f) and stroke (S) [the path of] the circle
             'b' + UPDFWriter.NewLine;

//            'b' + UPDFWriter.NewLine + 'BT' + UPDFWriter.NewLine;

 //add the commands to the page
 Writer.AddLowLevelDrawingCommandsToPage(Commands);

 Writer.SetColor(OldColor);            //restore the original color
end;












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

{Sets the text mode.
~param InText whether text mode should be entered }
procedure TPDFDiagramDrawer.SetTextMode(InText: Boolean);
begin
 if InText <> FInText then               //not already in the mode?
  begin
   FInText := InText;                      //set the new mode
   if InText then                          //and
    FWriter.BeginText                        //enter or
   else
    FWriter.EndText;                         //leave the text mode
  end;
end;




{Allows the object to initialize itself with the size of the diagram.
~param Size       the size of the image of the diagram in pixels
~param FontHeight the height of the font in pixels }
procedure TPDFDiagramDrawer.Initialize(Size: TPoint; FontHeight: Integer);
var       FontType         :TPDFFontType; //the font to be used in the diagram
begin
 FDiagramSize := Size;                    //save the size of the diagram

 //calculate scaling factor for maximum size of the diagram
 if Assigned(FScaleCallBack) then
  FImageScale := FScaleCallBack(Size)
 else
  FImageScale := 1.0;

 //get size and position for the diagram
 FSize.x := Size.x * FImageScale;
 FSize.y := Size.y * FImageScale;
 FOffset := FTextWriter.MakeRoomForImage(FSize.x, FSize.y);

 FInText := True;                         //we start out in text mode


 //try to find the font selected for the diagram
 if (Diagram.Font.Name = 'Arial') or (Diagram.Font.Name = 'Helvetica') then
  FontType := pftHelvetica
 else
  if Copy(Diagram.Font.Name, 1, 5) = 'Times' then
   FontType := pftTimes
  else
   if Copy(Diagram.Font.Name, 1, 5) = 'Courier' then
    FontType := pftCourier
   else
    //or if it is unknown, just use Helvetica
    FontType := pftHelvetica;

// Screen.Fonts.IndexOf('Arial') ...
//      EnumFonts(DC, nil, @EnumFontsProc, Pointer(FFonts));
//        case lg.lfPitchAndFamily and $F0 of
//          FF_MODERN: pftCourier   //monospaced
//          FF_ROMAN:  pftTimes     //serif
//          FF_SWISS:  pftHelvetica //sans-serif
//         else        pftHelvetica //unknown, just use default

 //and set the new font for the diagram
 FFontHandle := FTextWriter.PushFont(FontType, [],
                                     FImageScale * (FontHeight * 0.8),
                                     clBlack);
 FWriter.SetFont(FontType, FTextWriter.CurrentFont.Size, []);
 FWriter.SetColor(clBlack);

 //calculate the offset to the base line
 FBaseLineOffset := FImageScale * FontHeight * FWriter.Font.Ascent / 1000;

 //set the width of lines to 1 (times the scaling factor)
 FWriter.DoLowLevelDrawingCommand(PDFNumberToStr(1 * FImageScale) + ' w');
end;


{Allows the object to finish drawing the diagram and clean up. }
procedure TPDFDiagramDrawer.Finish;
begin
 FTextWriter.PopFont(FFontHandle);           //restore the original font
 with FTextWriter.CurrentFont do
  begin
   FWriter.SetFont(Font, Size, Style);
   FWriter.SetColor(Color);
  end;
 //set the width of lines to 1
 FWriter.DoLowLevelDrawingCommand('1 w');
end;