ubasepdfdoc.pas

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

function TBasePDFDoc.HandleRawText(const Text: String): String;
var      p          :PChar;   //runner through the text
begin
 if KeepRawLineBreaks then    //line breaks should be kept?
  begin
   Result := '';                //no text encoded so far
   if Text <> '' then           //text not empty?
    begin
     p := Pointer(Text);
     while p^ <> #0 do           //for each character in the text
      begin
       while not (p^ in [#0, #10]) do //all normal characters
        begin
         Result := Result + p^;         //just append them
         inc(p);
        end;
       if p^ = #10 then               //new line?
        begin                           //append a newline
         Result := Result + #10 + InternFormatCharacter + InternFormatNewLine;
         inc(p);                        //next character
        end;
      end; //while p^ <> #0
    end; //if Text <> ''
  end //if KeepRawLineBreaks
 else
  Result := Text;               //just return the text
end;







{Returns the text in the format; text may already include other formats.
~param TextFormat      the format the text should be in
~param Text            the text to format
~param SkipWhitespaces out: if following white spaces should be
                            skipped/ignored
~result the formatted text }
function TBasePDFDoc.FormatText(TextFormat: TDocumentationTextFormat;
                                const Text: String;
                                var SkipWhitespaces: Boolean): String;

 {Returns the given text in the intermediary code while preserving the
  indentation.
 ~result the formatted text }
 function LineFeeded: String;

  {Trims only spaces and tabulators from the right side of a string, this is
   done, so control characters of the PDF generator are not stripped from the
   line.
   ~param Text the text whose right side should be stripped of white spaces
   ~result the text without white spaces at its end }
  function TrimSpacesTabsRight(const Text: String): String;
  var      i                  :Integer;     //counter through the white spaces
  begin
   i := Length(Text);
   while (i >= 1) and (Text[i] in [' ', #9]) do //run through white spaces
    Dec(i);
   Result := Copy(Text, 1, i);              //return text without white spaces
  end;

 var      List      :TStringList;   //a list to handle the text line by line
          i         :Integer;       //counter through the lines
          S         :String;        //each line
          spacesind :Integer;       //index of the next multiple whitespaces
          p         :PChar;         //runner through the whitespaces
          endspace  :Integer;       //the index of the first non-whitespace
          numspaces :Integer;       //number of whitespaces
 begin
  List := TStringList.Create;       //create list for by-line access
  try
    Result := '';                   //result empty so far
    List.Text := Text;              //split text in lines

    if TrimLeft(List[0]) = '' then  //first line is empty?
     i := 1                           //skip it
    else
     i := 0;
    for i := i to List.Count - 1 do //for each line
     begin
      S := TrimSpacesTabsRight(List[i]); //get the line

      if (S <> '') and (S[1] = ' ') and (S[2] <> ' ') then //indented by one?
       begin
        Result := Result +              //add indentation
                  InternFormatCharacter + InternFormatIndent + Char(1);
        Delete(S, 1, 1);                //remove the one space
       end;

      spacesind := pos('  ', S);      //index of first multiple spaces
      while spacesind <> 0 do         //multiple spaces in the line?
       begin
        p := Pointer(S);
        inc(p, spacesind + 1);          //go behind the two spaces
        while p^ = ' ' do               //skip and count all spaces
         inc(p);
        //calculate index of first non-spaces after spaces
        endspace := Cardinal(p) - Cardinal(Pointer(S)) + 1;
        //calculate number of spaces
        numspaces := endspace - spacesind;
        //add the preceding text and the space-equivalent format
        Result := Result + copy(S, 1, spacesind - 1) +
                  InternFormatCharacter + InternFormatIndent + Char(numspaces);
        Delete(S, 1, endspace - 1);     //delete text and spaces
        spacesind := pos('  ', S);      //search next multiple spaces
       end; //while spacesind <> 0

      //line breaks not already inserted?
      if not KeepRawLineBreaks then
       S := S + InternFormatCharacter + InternFormatNewLine; //end the line
      Result := Result + S; //add final text
     end; //for i := i to List.Count - 1
  finally
   List.Free;                             //now free the list
  end;
 end;


begin
 case TextFormat of   //depending on the requested format, format the text
   dtfCode:         Result := InternFormatCharacter + InternFormatFixed +
                              Text +                    //fixed character width
                              InternFormatEndCharacter;
   dtfEmphasize:    Result := InternFormatCharacter + InternFormatItalic +
                              Text + InternFormatEndCharacter;  //italy
   dtfPreFormatted: begin      //fixed character width and preserve whitespaces
                     Result := InternFormatCharacter + InternFormatNewLine +
                               InternFormatCharacter + InternFormatFixed +
                               LineFeeded + InternFormatEndCharacter +
                               InternFormatCharacter + InternFormatNewLine;
                     SkipWhitespaces := True;
                    end;
   dtfSample:       begin      //fixed character width and preserve whitespaces
                     Result := InternFormatCharacter + InternFormatParagraph +
//                               InternFormatCharacter + InternFormatBold +
//                               'Sample:' + InternFormatEndCharacter +
//                               InternFormatCharacter + InternFormatNewLine +
                               InternFormatCharacter + InternFormatFixed +
                               LineFeeded + InternFormatEndCharacter +
                               InternFormatCharacter + InternFormatParagraph;
                     SkipWhitespaces := True;
                    end;
 else
  Result := Text;
 end;
end;








{Writes a link to an identifier or file in the documentation.
~param URI       the URI in the documentation to write a link to
~param LinkLabel the label for the link; if empty URI is used
~result a link to the identifier }
function TBasePDFDoc.InternalLink(const URI, LinkLabel: String): String;
begin
 Result := LinkLabel;
 if Result = '' then                              //no label given?
  Result := URI;                                    //use URI

 //return the link to the URI
 Result := InternFormatCharacter + InternFormatLink + URI +
           InternFormatEndCharacter + Result + InternFormatEndCharacter;
end;

{Writes a link to an external URI.
~param URI       the URI to write a link to
~param LinkLabel the label for the link; if empty URI is used
~result a link to the URI }
function TBasePDFDoc.ExternalLink(const URI, LinkLabel: String): String;
begin
 Result := LinkLabel;
 if Result = '' then                              //no label given?
  Result := URI;                                    //use URI

 //return the link to the URI
 if pos('://', URI) = 0 then
  Result := InternFormatCharacter + InternFormatFileLink + URI +
            InternFormatEndCharacter + Result + InternFormatEndCharacter
 else
  Result := InternFormatCharacter + InternFormatExternLink + URI +
            InternFormatEndCharacter + Result + InternFormatEndCharacter;
end;



{$UNDEF KYLIX_OR_NOJPEG}
{$IFDEF NOJPEGSUPPORT}
 {$DEFINE KYLIX_OR_NOJPEG}
{$ENDIF}
{$IFDEF LINUX}
 {$DEFINE KYLIX_OR_NOJPEG}
{$ENDIF}


{Includes an image in the documentation.
~param CharFormat      if the image should be included as a simple
                       character instead of centered in an own paragraph
~param JPEGFormat      if the file should be converted to JPEG instead of
                       PNG (only for HTML formats)
~param Resolution      resolution to use, (0,0) means auto-detect;
                       only for JPEG images for PDF-generator if no JPEG
                       support is available
~param BMP             the image to include or nil
~param FileName        the name of the file with the image to include, if BMP
                       is nil
~param Links           list of links inside the image
~param AlternativeText alternative text/description of the image
~result the format to include the image }
function TBasePDFDoc.WriteImage(CharFormat, JPEGFormat: Boolean;
                                Resolution: TPoint;
                                BMP: TBitmap; const FileName: String;
                                Links: TImageLinkList;
                                const AlternativeText: String): String;
{$IFNDEF NOJPEGSUPPORT}
 {$IFDEF LINUX}
const    ConvertToJPEG_TempFileName = 'Temp_ConvertToJPEG.jpg';
 {$ENDIF}
{$ENDIF}
var      UniqueName      :String;        //unique name of the image file
         ImageIndex      :Integer;       //the index of the image
         NeedFree        :Boolean;       //bitmap needs to be freed?
{$IFNDEF KYLIX_OR_NOJPEG}
         JPG             :TMemoryStream; //the screen shot converted to JPEG
         JPGConverter    :TJPEGImage;    //convertes the screen shot to JPEG
{$ELSE}
         JPG             :TFileStream;   //the screen shot as an JPEG file
{$ENDIF}
         ImageSize       :TPoint;        //size of the image
         LinkCount       :Integer;       //number of valid links in image
         i               :Integer;       //general counter
begin
 if not assigned(FWriter) then           //before generating documentation?
  begin
   AddPositionMessage(MakeDocMessagesID, Ord(mdmkNotSupported),
             DocumentationTexts[dtImagesInManuallyUserDocInPDFNotSupported].T);
   Result := '';
  end
 else
  begin
   UniqueName := ExtractShortPathName(FileName); //get unique name of image

   if not assigned(BMP) then                     //image is a file?
    ImageIndex := FImagePaths.IndexOf(UniqueName)  //already in PDF file?
   else
    ImageIndex := -1;                              //can't be buffered
   if ImageIndex <> -1 then                //image is already in the PDF file?
    begin
     //get the index of the image
     ImageIndex := Integer(FImagePaths.Objects[ImageIndex]);
     //get the size of the image
     ImageSize := FWriter.GetImageSize(Format(ImageNameFormat, [ImageIndex]));
    end
   else
    begin

{$IFNDEF KYLIX_OR_NOJPEG}
     JPGConverter := TJPEGImage.Create; //create the object for the JPEG image
     try
{$ENDIF}

       NeedFree := not assigned(BMP);
       if NeedFree then
        BMP := TBitmap.Create;             //create bitmap
       try
         if NeedFree then
          BMP.LoadFromFile(FileName);      //and load the specified bitmap

         ImageSize.x := BMP.Width;         //save size of the image
         ImageSize.y := BMP.Height;

{$IFNDEF KYLIX_OR_NOJPEG}
         JPGConverter.CompressionQuality := 100;
         JPGConverter.ProgressiveEncoding := False;
         JPGConverter.Assign(BMP);         //convert the bitmap to a JPEG image
         JPGConverter.Compress;
         JPGConverter.JPEGNeeded;
{$ENDIF}
       finally
        if NeedFree then
         BMP.Free;
       end;

{$IFNDEF NOJPEGSUPPORT}
 {$IFDEF LINUX}
       //convert the bitmap to a jpeg
       ConvertBMPToJPEG(BMP, '', FDestPath + ConvertToJPEG_TempFileName);
 {$ENDIF}
{$ENDIF}


{$IFNDEF KYLIX_OR_NOJPEG}
       JPG := TMemoryStream.Create;          //create the stream
       try
         JPGConverter.SaveToStream(JPG);     //get the data of the jpeg image
         JPG.Position := 0;                  //and get back to the beginning
{$ELSE}
       //open the jpeg file as a simple file stream
       JPG := TFileStream.Create(
 {$IFNDEF NOJPEGSUPPORT}
                                 FDestPath + ConvertToJPEG_TempFileName,
 {$ELSE}
                                 //assume it has been converted manually before
                                 ChangeFileExt(FileName, '.jpg'),
 {$ENDIF}
                                 fmOpenRead or fmShareDenyWrite);
       try
{$ENDIF}

         inc(FImageIndex);                   //next image
         ImageIndex := FImageIndex;          //save the index

         //draw the image
         FWriter.AddImage(JPG, ImageSize,
                          Format(ImageNameFormat, [ImageIndex]),
                          FInterpolateImages);

         if not assigned(BMP) then           //image is a file?
          //save the unique name of the file and its index
          FImagePaths.AddObject(UniqueName, TObject(ImageIndex));

       finally
        JPG.Free;            //close the jpeg file/free the stream of jpeg data
       end;

{$IFNDEF KYLIX_OR_NOJPEG}
     finally
      JPGConverter.Free;                     //free the JPEG image object
     end;
{$ENDIF}
    end; //else ImageIndex <> -1



   if Links.Count = 1 then                   //only one link?
    with Links[0] do
     if IsAll then                             //is a link on the whole file?
      begin
       IsAll := False;                         //don't ignore it
       //set it on the whole file
       Position := Rect(0, 0, ImageSize.x, ImageSize.y);
      end;

   LinkCount := 0;
   for i := 0 to Links.Count - 1 do            //for each link
    if not Links[i].IsAll then                   //if it is valid
     inc(LinkCount);                               //count it


   //start command in the intermediary code
   Result := InternFormatCharacter + InternFormatImage +
             Char(ImageIndex shr 24) + Char(ImageIndex shr 16) +
             Char(ImageIndex shr 8) + Char(ImageIndex) +
             Char(CharFormat) +