updfwriter.pas

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

              556,500,444,444,444,444,444,444,667,444,444,444,444,444,278,278,
              278,278,500,500,500,500,500,500,500,564,500,500,500,500,500,500,
              500,500);

          //widths of characters of Times (New Roman) in bold style
          CharWidths_TimesNewRoman_Bold: TCharWidths = (
              250,333,555,500,500,1000,833,278,333,333,500,570,250,333,
              250,278,500,500,500,500,500,500,500,500,500,500,333,333,570,570,
              570,500,930,722,667,722,722,667,611,778,778,389,500,778,667,944,
              722,778,611,778,722,556,667,722,722,1000,722,722,667,333,278,333,
              581,500,333,500,556,444,556,444,333,500,556,278,333,556,278,833,
              556,500,556,556,444,389,333,556,500,722,500,500,444,394,220,394,
              520,0,500,0,333,500,500,1000,500,500,333,1000,556,333,1000,0,
              667,0,0,333,333,500,500,350,500,1000,333,1000,389,333,722,0,
              444,722,0,333,500,500,500,500,220,500,333,747,300,500,570,0,
              747,333,400,570,300,300,333,556,540,250,333,300,330,500,750,750,
              750,500,722,722,722,722,722,722,1000,722,667,667,667,667,389,389,
              389,389,722,722,778,778,778,778,778,570,778,722,722,722,722,722,
              611,556,500,500,500,500,500,500,722,444,444,444,444,444,278,278,
              278,278,500,556,500,500,500,500,500,570,500,556,556,556,556,500,
              556,500);

          //widths of characters of Times (New Roman) in italic style
          CharWidths_TimesNewRoman_Italic: TCharWidths = (
              250,333,420,500,500,833,778,214,333,333,500,675,250,333,
              250,278,500,500,500,500,500,500,500,500,500,500,333,333,675,675,
              675,500,920,611,611,667,722,611,611,722,722,333,444,667,556,833,
              667,722,611,722,611,500,556,722,611,833,611,556,556,389,278,389,
              422,500,333,500,500,444,500,444,278,500,500,278,278,444,278,722,
              500,500,500,500,389,389,278,500,444,667,444,444,389,400,275,400,
              541,0,500,0,333,500,556,889,500,500,333,1000,500,333,944,0,
              556,0,0,333,333,556,556,350,500,889,333,980,389,333,667,0,
              389,556,0,389,500,500,500,500,275,500,333,760,276,500,675,0,
              760,333,400,675,300,300,333,500,523,250,333,300,310,500,750,750,
              750,500,611,611,611,611,611,611,889,667,611,611,611,611,333,333,
              333,333,722,667,722,722,722,722,722,675,722,722,722,722,722,556,
              611,500,500,500,500,500,500,500,667,444,444,444,444,444,278,278,
              278,278,500,500,500,500,500,500,500,675,500,500,500,500,500,444,
              500,444);

          //widths of characters of Times (New Roman) in bold and italic style
          CharWidths_TimesNewRoman_BoldItalic: TCharWidths = (
              250,389,555,500,500,833,778,278,333,333,500,570,250,333,
              250,278,500,500,500,500,500,500,500,500,500,500,333,333,570,570,
              570,500,832,667,667,667,722,667,667,722,778,389,500,667,611,889,
              722,722,611,722,667,556,611,722,667,889,667,611,611,333,278,333,
              570,500,333,500,500,444,500,444,333,500,556,278,278,500,278,778,
              556,500,500,500,389,389,278,556,444,667,500,444,389,348,220,348,
              570,0,500,0,333,500,500,1000,500,500,333,1000,556,333,944,0,
              611,0,0,333,333,500,500,350,500,1000,333,1000,389,333,722,0,
              389,611,0,389,500,500,500,500,220,500,333,747,266,500,606,0,
              747,333,400,570,300,300,333,576,500,250,333,300,300,500,750,750,
              750,500,667,667,667,667,667,667,944,667,667,667,667,667,389,389,
              389,389,722,722,722,722,722,722,722,570,722,722,722,722,722,611,
              611,500,500,500,500,500,500,500,722,444,444,444,444,444,278,278,
              278,278,500,556,500,500,500,500,500,570,500,556,556,556,556,444,
              500,444);

begin
 //create Courier (New) fonts
 FFonts[pftCourier, 0] := TType1Font.Create(CharWidths_Courier,
                                            CharWidths_Courier[#32],
                                            629, -157);
 FFonts[pftCourier, 1] := TType1Font.Create(CharWidths_Courier,
                                            CharWidths_Courier[#32],
                                            629, -157);
 FFonts[pftCourier, 2] := TType1Font.Create(CharWidths_Courier,
                                            CharWidths_Courier[#32],
                                            629, -157);
 FFonts[pftCourier, 3] := TType1Font.Create(CharWidths_Courier,
                                            CharWidths_Courier[#32],
                                            629, -157);

 //create Helvetica (Arial) fonts
 FFonts[pftHelvetica, 0] := TType1Font.Create(CharWidths_Helvetica,
                                              0, 718, -207);
 FFonts[pftHelvetica, 1] := TType1Font.Create(CharWidths_Helvetica_Bold,
                                              0, 718, -207);
 FFonts[pftHelvetica, 2] := TType1Font.Create(CharWidths_Helvetica,
                                              0, 718, -207);
 FFonts[pftHelvetica, 3] := TType1Font.Create(CharWidths_Helvetica_Bold,
                                              0, 718, -207);

 //create Times (New Roman) fonts
 FFonts[pftTimes, 0] := TType1Font.Create(CharWidths_TimesNewRoman,
                                              0, 683, -217);
 FFonts[pftTimes, 1] := TType1Font.Create(CharWidths_TimesNewRoman_Bold,
                                              0, 683, -217);
 FFonts[pftTimes, 2] := TType1Font.Create(CharWidths_TimesNewRoman_Italic,
                                              0, 683, -217);
 FFonts[pftTimes, 3] := TType1Font.Create(CharWidths_TimesNewRoman_BoldItalic,
                                              0, 683, -217);

// FZapfDingbats := TType1Font.Create(CharWidths_ZapfDingbats, 0, 820, -143);
end;

{Returns the representation of a rect in the PDF file.
~param Rect the rect whose representation in the PDF file should be returned
~result the representation of the rect }
function TPDFWriter.GetBox(Rect: TPDFRect): String;
begin
 //return all components separated by a space
 Result := PDFNumberToStr(Rect.Left) + ' ' +
           PDFNumberToStr(Rect.Top) + ' ' +
           PDFNumberToStr(Rect.Right) + ' ' +
           PDFNumberToStr(Rect.Bottom);
end;




{Write the resources of the page(s).
~param Images list of names of the images on the page }
procedure TPDFWriter.WriteResources(Images: TStrings = nil);
var       i         :Integer;          //counter through all images
begin
 Write('/Resources <<');
 Write('/Font <<');                  //all fonts are used in all pages
 Write('/F0 3 0 R');                 //they are only the default fonts so, that
 Write('/F1 4 0 R');                 //shouldn't waste to much resources
 Write('/F2 5 0 R');
 Write('/F3 6 0 R');
 Write('/F4 7 0 R');
 Write('/F5 8 0 R');
 Write('/F6 9 0 R');
 Write('/F7 10 0 R');
 Write('/F8 11 0 R');
 Write('/F9 12 0 R');
 Write('/F10 13 0 R');
 Write('/F11 14 0 R');

 Write('/F12 15 0 R');               //and here we got the "symbols"

 Write('>>');
 if not Assigned(Images) or (Images.Count = 0) then  //no images?
  Write('/ProcSet [/PDF /Text ]')      //use this "tool packages" for all pages
 else
  begin
   Write('/XObject <<');               //write the references to the images
   for i := 0 to Images.Count - 1 do
    WriteFormatted('/%s %d 0 R',
                   [Images[i],
                    TPDFObjectNumber(FImages.Objects[FImages.
                                                        IndexOf(Images[i])])]);
   Write('>>');

   //use this "tool packages" for this page, including that one for
   Write('/ProcSet [/PDF /Text /ImageC ]')         //images (with color)
  end;
 Write('>>');
end;




{Gets a font object by its styles.
~param Font  the font to be used
~param Style the styles of the font
~result the specified font }
function TPDFWriter.GetFont(Font: TPdfFontType;
                            Style: TPdfFontStyles): TType1Font;
var      Index     :Integer;             //index of the style
begin
 Index := Ord(pfsBold in Style);         //get index of the style
 if pfsItalic in Style then
  Inc(Index, 2);

 Result := FFonts[Font, Index];          //return the font
end;


         //type of characters needing quoting, as a separate type to make sure
         //both constants have the same length
type     TPDFQuoteChars = array[0..7] of Char;
         //the characters needing quoting
const    PDFEscapeChars: TPDFQuoteChars =
                          ('(', ')', '\', #13, #10, #09, #08, #12);
         //the characters to quote the original characters after a backslash
         PDFReplaceChars: TPDFQuoteChars =
                          ('(', ')', '\', 'r', 'n', 't', 'b', 'f');


{Returns a string as a text in the PDF file.
~param S the text to return as a text in PDF format
~result the PDF representation of a text }
function TPDFWriter.StrToPDFStr(const S: String): String;
var      i         :Integer;              //index of all characters
         SetPos    :PChar;        //position in Result to copy the character to
         C         :Char;                 //each character in the string
         Index     :Integer;              //index if character in EscapeChars
begin
 SetLength(Result, Length(S) * 4 + 2);    //create maximum buffer
 SetPos := Pointer(Result);               //set position to fill it
 Inc(SetPos);
 for i := 1 to Length(S) do               //for each character
  begin
   C := S[i];                               //get it
   if C in ['(', ')', '\', #0..#31] then    //needs quoting?
    begin
     SetPos^ := '\';                          //add quote for the character
     Inc(SetPos);
     Index := MemoryScan(Ord(C), @PDFEscapeChars, Length(PDFEscapeChars));
     if Index <> -1 then                        //a specially quoted character?
      SetPos^ := PDFReplaceChars[Index]         //add the quoted version
     else
      begin                                     //quote via octal code
       SetPos^ := Char(Ord('0') + Ord(C) div 64);
       Inc(SetPos);
       SetPos^ := Char(Ord('0') + Ord(C) div 8 mod 8);
       Inc(SetPos);
       SetPos^ := Char(Ord('0') + Ord(C) mod 8);
      end;
    end
   else
    SetPos^ := C;                             //add the character
   Inc(SetPos);                             //next position for next character
  end;
 SetLength(Result, SetPos - Pointer(Result) + 1);    //use only filled part
 Result[1] := '(';                        //texts are enclosed in "()"
 Result[Length(Result)] := ')';
end;

{Returns a number of characters as a text in the PDF file.
~param Characters the characters to return as a text in PDF format
~param Count      the number of characters to be used as text
~result the PDF representation of a text }
function TPDFWriter.CharactersToPDFStr(Characters: PChar;
                                       Count: Integer): String;
var      i         :Integer;              //index of all characters
         SetPos    :PChar;        //position in Result to copy the character to
         C         :Char;                 //each character in the string
         Index     :Integer;              //index if character in EscapeChars
begin
 SetLength(Result, Count * 4 + 2);        //create maximum buffer
 SetPos := Pointer(Result);               //set position to fill it
 Inc(SetPos);
 for i := 1 to Count do                   //for each character
  begin
   C := Characters^;                        //get it
   if C in ['(', ')', '\', #0..#31] then    //needs quoting?
    begin
     SetPos^ := '\';                          //add quote for the character
     Inc(SetPos);
     Index := MemoryScan(Ord(C), @PDFEscapeChars, Length(PDFEscapeChars));
     if Index <> -1 then                        //a specially quoted character?
      SetPos^ := PDFReplaceChars[Index]         //add the quoted version
     else
      begin                                     //quote via octal code
       SetPos^ := Char(Ord('0') + Ord(C) div 64);
       Inc(SetPos);
       SetPos^ := Char(Ord('0') + Ord(C) div 8 mod 8);
       Inc(SetPos);
       SetPos^ := Char(Ord('0') + Ord(C) mod 8);
      end;
    end
   else
    SetPos^ := C;                             //add the character
   Inc(SetPos);                             //next position for next character
   Inc(Characters);                         //next character
  end;
 SetLength(Result, SetPos - Pointer(Result) + 1);    //use only filled part
 Result[1] := '(';                        //texts are enclosed in "()"
 Result[Length(Result)] := ')';
end;


{Returns a string as a text in the PDF file in a binary representation. For PDF
 it makes not difference whether this function or ~[link StrToPDFStr] is used
 to convert a string into a PDF string, only the size of the resulting string
 may differ and the readability by humans.
~param S the text to return as a text in PDF format
~result the PDF representation of a text }
function TPDFWriter.StrToBinaryPDFStr(const S: String): String;
begin
 if S = '' then                                     //string is empty?
  Result := '<>'                                      //return empty text
 else
  Result := BufferToBinaryPDFStr(Pointer(S), Length(S)); //return binary text
end;

{Returns a buffer of bytes as a text in the PDF file in a binary
 representation.
~param Buffer the buffer to return as a text in PDF format
~param Count  the number of characters the buffer holds
~result the PDF representation of the buffer }
function TPDFWriter.BufferToBinaryPDFStr(Buffer: Pointer;
                                         Count: Integer): String;
begin
 SetLength(Result, (Count + 1) * 2);            //get space for binary string
 Result[1] := '<';                              //set start and end-marker
 Result[Length(Result)] := '>';
 BinToHex(Buffer, @Result[2], Count);           //convert bytes to hex
end;


{Begins a new PDF object at the current position and returns its number.
~result the number of the freshly created PDF object }
function TPDFWriter.GetAddObjPosNumber: TPDFObjectNumber;
begin
 FObjPositions.Add(Pointer(Stream.Position));   //add position of the object

 Result := FObjPositions.Count;                 //return the index of it
end;

{Writes some text into the stream.
~param Str     the text to write
~param NewLine whether an end-of-line sequence should also be written }
procedure TPDFWriter.Write(const Str: String; NewLine: Boolean = True);
var       Text      :String;                  //the text to be written
begin
 Text := Str;

 //insert an extra line break before "<<" and after ">>"
 if NewLine and (Length(Text) > 3) then
  if Copy(Text, Length(Text) - 2, 3) = ' <<' then
   Text[Length(Text) - 2] := #10
  else
   if Text = '>> endobj' then
    Text[3] := #10;