ubasepdfdoc.pas

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

             Char((Word(LinkCount) shr 8)) + Char(Word(LinkCount));

   for i := Links.Count - 1 downto 0 do    //for each link
    with Links[i] do
     if not IsAll then                       //if it is valid
      with Position do                         //add its data
       Result := Result + Char((Word(Left) shr 8)) + Char(Word(Left)) +
                          Char((Word(Top) shr 8)) + Char(Word(Top)) +
                          Char((Word(Right) shr 8)) + Char(Word(Right)) +
                          Char((Word(Bottom) shr 8)) + Char(Word(Bottom)) +
                          Char(ExternLink) +
                          LinkTarget + #0;
 end;
end;
















































{Returns the token of a string (formatted) in the format of the documentation.
 It is fomatted with the intermediary code, which will colorize it red.
~param StringToken the string token
~result the encoded string token in a special format }
function TBasePDFDoc.FormatStringToken(const StringToken: String): String;
begin
 Result := InternFormatCharacter + InternFormatString +
           HandleRawText(StringToken) +
           InternFormatEndCharacter;
end;











{Returns the format needed to express the scope (as an icon).
~param Scope the scope to show
~result the format to express the scope }
function TBasePDFDoc.GetScope(Scope: TScope): String;
         //the symbols of the scopes
const    ScopeSymbols: array[TScope] of TSymbol =
                        (TSymbol(-1), sUnitInterface, sUnitLocal,
                         sPrivate, sProtected, sPublic, sPublished, sAutomated,
                         TSymbol(-1));
begin
 if ScopeSymbols[Scope] <> TSymbol(-1) then      //icon of the scope available?
  Result := InternFormatCharacter + InternFormatSymbol +  //return it
            Char(ScopeSymbols[Scope])
 else
  Result := '';                                           //no icon
end;

{Returns the format needed to express the portability issues (as icons).
~param Issues the portability issues to show (may be the empty set)
~result the format to express the portability issues }
function TBasePDFDoc.GetPortabilityIssues(Issues: TIdentPortabilities): String;
         //the symbols of the portability issues
const    IdentPortabilitySymbols: array[TIdentPortability] of TSymbol =
                                       (sDeprecated, sLibrary, sPlatform);
var      p          :TIdentPortability; //runner through all portability issues
begin
 Result := '';                         //no icons needed so far
 for p := low(p) to high(p) do         //for each portability issue
  if p in Issues then                    //that is requested
   //return the format for including the icon
   Result := Result + InternFormatCharacter + InternFormatSymbol +
                      Char(IdentPortabilitySymbols[p]);
end;


















{Returns a string expressing the current position in the documentaton by
 the number of its section, subsection and so on.
~result the numbers of the section, subsection etc. }
function TBasePDFDoc.GetSectionString: String;
begin
 if FMainSectionNumber <> 0 then              //in a chapter?
  begin
   Result := IntToRoman(FMainSectionNumber);    //return its number
   if FSectionNumber <> 0 then                  //in a section?
    begin
     Result := Result + Format('.%d', [FSectionNumber]); //append its number
     if FSubSectionNumber <> 0 then               //also in a subsection?
      begin
       Result := Result + Format('.%d', [FSubSectionNumber]); //append number
       if FItemSectionNumber <> 0 then              //documentation of an item?
        Result := Result + Format('.%d', [FItemSectionNumber]); //append number
      end;
    end;
  end
 else
  Result := '';
end;




{Writes the header and footer of current page. }
procedure TBasePDFDoc.WritePageMarkings;
var       LeftMargin  :TPDFValue;     //the original indentation of if the text
          S           :String;        //string to write
begin
 if (FMainSectionNumber <> 0) or (FPage <> 0) then //not the title page?
  begin
   FWriter.BeginText;                   //begin the header and footer

   //set font of the header and footer
   FWriter.SetFont(FPageFontType, FPageFontSize, FPageFontStyle);

   if FMainSectionNumber <> 0 then      //in a chapter/section/etc.?
    begin
     LeftMargin := FIndention;            //save indentation
     try
       FXPos := FPageRect.Left;           //set position of the header
       FYPos := FPageRect.Top + FPageFontSize * 2.5;
       FWriter.MoveTextPoint(FXPos, FYPos);

       S := GetSectionString;             //get position in the documentation
       if FSectionNumber <> 0 then
        begin
         S := S + ' ' + FSectionName;
         if FSubSectionName <> '' then
          S := S + ' - ' + FSubSectionName;
        end
       else
        if FMainSectionName <> '' then
         S := S + ' ' + FMainSectionName;
       FWriter.ShowText(S);               //and write it

       S := FItemSectionName;             //get current item
       if S <> '' then
        begin
         FXPos := FPageRect.Right - FWriter.TextWidth(S);
         FWriter.SetTextPoint(FXPos, FYPos);
         FWriter.ShowText(S);               //write the current item
        end;

       FXPos := FPageRect.Left;           //write chapter in the footer
       FYPos := FPageRect.Bottom - FPageFontSize * 2.5;
       FWriter.SetTextPoint(FXPos, FYPos);
       FWriter.ShowText(FMainSectionName);

     finally
      FIndention := LeftMargin;         //restore indentation
      FLeftLineStart := FPageRect.Left + LeftMargin;
     end;
    end; //if FMainSectionNumber <> 0


   if FPage <> 0 then                 //has a valid page number?
    begin
     if FRomanPageNumber then
      S := IntToRoman(FPage)
     else
      S := Format('%d', [FPage]);

     FXPos := FPageRect.Right - FWriter.TextWidth(S);
     FYPos := FPageRect.Bottom - FPageFontSize * 2.5;
     FWriter.SetTextPoint(FXPos, FYPos); //in the lower right corner ...
     FWriter.ShowText(S);                //write the page number
    end;                                                               

   FWriter.EndText;
  end; //not title page


 //set the font and color of the current text
 FWriter.SetFont(FCurrentFont, FCurrentSize, FCurrentStyle);
 if FCurrentColor <> clBlack then
  FWriter.SetColor(FCurrentColor);
end;



{Starts a new page.
~param FirstPage if it it the first page of the PDF document }
procedure TBasePDFDoc.NewPage(FirstPage: Boolean = False);
begin
 inc(FPage);                             //next page number
 if not FirstPage then                   //not the first page?
  begin
   HandleAnnotations(0);                   //handle nnotations of current line
   FWriter.InsertTextCommand('0 Tw'#10);   //reset word-spacing
   FWriter.EndText;                        //end the page

   FWriter.NewPage;                        //start a new page
  end
 else
  FWriter.FirstPage;                       //start the first page


 WritePageMarkings;                      //write header and footer

 FYPos := FPageRect.Top;                 //set position of text
 FXPos := FLeftLineStart;
 FWriter.BeginText;                      //begin text
 FWriter.SetTextPoint(FXPos, FYPos);     //at the position

 FWordsInLine := 0;                      //start a new line
 FCurrentWordsInLine := 0;
 FBiggestFontSize := 0;
 FWriter.SaveInsertionPoint;
end;

{Starts a new page if the current is not still empty. }
procedure TBasePDFDoc.ClearPage;
begin
 //current position not the start position of the page
 if (FYPos <> FPageRect.Top) or
    ((FXPos <> FLeftLineStart) and
     (FXPos <> FPageRect.Left)) then
  NewPage;                            //it's not empty => start a new page
end;

{Starts a new page, if the given number of lines won't fit on the current one.
~param Lines number of lines to ensure space for }
procedure TBasePDFDoc.EnsurePageLines(Lines: Integer);
begin
 //not enough space for the given numbers of lines?
 if FYPos < FPageRect.Bottom +
            Lines * FNormalFontSize * FLineDistanceScale then
  NewPage;                         //start a new page
end;





{Registers the current position in the document by the internal name as a
 target for links.
~param LabelName the name to register the position with }
procedure TBasePDFDoc.CreateDestination(const LabelName: String);
begin               //register the destination
 FWriter.AddDestination(FXPos, FYPos + FWriter.Size, LabelName);
end;




{Starts a new chapter/part of the documentation.
~param Title        the title of the chapter/part of the documentation.
~param LabelName    the internal name of the chapter/part of the documentation
                    for links to it
~param OutlineEntry the outline entry to use, instead of generating a new one,
                    if not nil }
procedure TBasePDFDoc.WriteNewMainSection(const Title, LabelName: String;
                                          OutlineEntry: POutlineEntry = nil);
          //the new outline entry of the main section
var       Entry      :^POutlineEntry;
begin
 inc(FMainSectionNumber);                     //get number of the main section
 FSectionNumber := 0;                         //reset the contained sections
 FSubSectionNumber := 0;
 FItemSectionNumber := 0;
 FMainSectionName := Title;                   //set the title of the section
 FSectionName := '';                          //and not in a sub section, so
 FSubSectionName := '';                       //clear their titles
 FItemSectionName := '';
 if not assigned(OutlineEntry) then           //no outline entry defined, yet?
  begin
   inc(FOutlineRoot.Count);                     //add an entry
   if assigned(FMainSectionOutlineEntry) then   //not the first entry?
    Entry := @FMainSectionOutlineEntry.Next       //append entry to the list
   else
    Entry := @FOutlineRoot.First;                 //add as the first entry
   New(Entry^);                                 //create the entry
   Entry^.Next := nil;                          //initialize data
   Entry^.First := nil;
   Entry^.Count := 0;
   FMainSectionOutlineEntry := Entry^           //set entry as current one
  end
 else
  FMainSectionOutlineEntry := OutlineEntry;   //just use the entry
 FSectionOutlineEntry := nil;                 //no sub entries available so far
 FSubSectionOutlineEntry := nil;
 FMainSectionOutlineEntry.Title := Title;     //set title and internal link
 FMainSectionOutlineEntry.Dest := LabelName;  //target name

 ClearPage;                                   //start a new page
 SetFont(FDefaultFontType, FNormalFontSize * 2, [pfsBold]); //use a big font

 CreateDestination(LabelName);                //create link target
 //write title of main section
 WriteSimpleLine(GetSectionString + ' ' + Title, False);
 FYPos := FYPos - 0.5 * FNormalFontSize;      //some extra space
 FWriter.MoveTextPoint(0, - 0.5 * FNormalFontSize);
 SetFont(FDefaultFontType, FNormalFontSize);  //normal font after the title

 FMainSectionOutlineEntry.Page := FPage;      //save the current page
end;

{Starts a section of the documentation.
~param Title        the title of the section
~param LabelName    the internal name of the section for links to it }
procedure TBasePDFDoc.WriteNewSection(const Title, LabelName: String);
var       Entry