ubasehtmldoc.pas

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

 FCharacterEncoding := 'iso-8859-15';           //set the character encoding
end;








{Will be called for all reserved words. They are all formatted in a bold font,
 but "string" will just be replaced with a not bold "String".
~param Word a string of one ore more reserved words
~result Word formatted as reserved words }
function TBaseHTMLDoc.ReservedWord(const Word: String): String;
begin
 if Word = 'string' then           //is string?
  Result := 'String'                 //use this upper case variant, not bold
 else
  Result := '<b>' + Word + '</b>';   //format the word bold
end;





{Returns the number of available options in generators of this class.
~result the number of available "expert"-options
~see GetOptionDescription
~see GetOption
~see SetOption }
class function TBaseHTMLDoc.GetOptionCount: Cardinal;
begin
 Result := inherited GetOptionCount + 5;
end;

{Gets a description of an "expert"-option.
~param Index index of the option to get data of
~param Desc  out: the description of the option (name, type, default value,
                  etc.)
~see GetOptionCount }
class procedure TBaseHTMLDoc.GetOptionDescription(Index: Cardinal;
                                              var Desc: TOptionDescription);
var             PreOptionCount :Cardinal;  //number of options in parent class
begin
 PreOptionCount := inherited GetOptionCount; //get number of options in parent
 if Index < PreOptionCount then              //an option in the parent class?
  inherited GetOptionDescription(Index, Desc)  //forward to parent's method
 else
  begin
   ClearDescription(Desc);               //clear structure
   case Index - PreOptionCount of        //depending on index of option
     0: begin                            //set the values describing the option
         Desc.Name := 'DontOverrideCSSFile';
         Desc.Category := 'Generation';
         Desc.Description := 'Creates the CSS file only if it does not exist yet.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := False;
        end;
     1: begin
         Desc.Name := 'TextHeaderFile';
         Desc.Category := 'Generation.Templates';
         Desc.Description := 'The file to insert instead of the default text at the beginning of each HMTL-file, use <topic> <keywords> <mainpath> <encoding> to insert texts.';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := '';
        end;
     2: begin
         Desc.Name := 'TextFooterFile';
         Desc.Category := 'Generation.Templates';
         Desc.Description := 'The file to insert instead of the default text at the end of each HMTL-file.';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := '';
        end;
     3: begin
         Desc.Name := 'CharacterEncoding';
         Desc.Category := 'Generation';
         Desc.Description := 'The character encoding to set in the generated HTML files, f.i.: iso-8859-15, UTF-8, iso-8859-1, windows-1252';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := 'iso-8859-15';
        end;
     4: begin
         Desc.Name := 'DontQuoteSpecialCharacters';
         Desc.Category := 'Generation';
         Desc.Description := 'Whether special characters should not be encoded (i.e.: "&<>), if enabled raw HTML code can be used in comments, but of course other formats can not be generated anymore.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := False;
        end;
   else
    assert(Index >= GetOptionCount);
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
 end;
end;

{Gets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to get the value of
~result the value of the option
~see GetOptionCount
~see GetOptionDescription
~see SetOption }
function TBaseHTMLDoc.GetOption(Index: Cardinal): TOptionValue;
var      PreOptionCount :Cardinal;     //number of options in parent class
begin
 PreOptionCount := inherited GetOptionCount; //get number of options in parent
 if Index < PreOptionCount then              //an option in the parent class?
  Result := inherited GetOption(Index)         //forward to parent's method
 else
  begin
   case Index - PreOptionCount of              //depending on index of option
     0: Result.BoolData := FDontOverrideCSSFile; //get the value
     1: Result.StrData := FTextHeaderFile;
     2: Result.StrData := FTextFooterFile;
     3: Result.StrData := FCharacterEncoding;
     4: Result.BoolData := FDontQuoteSpecialCharacters;
   else
    assert(Index >= GetOptionCount);
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
  end;
end;

{Sets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to set the value
~param Value the new value of the option
~see GetOptionCount
~see GetOptionDescription
~see GetOption }
procedure TBaseHTMLDoc.SetOption(Index: Cardinal; const Value: TOptionValue);
var       PreOptionCount :Cardinal;     //number of options in parent class
begin
 PreOptionCount := inherited GetOptionCount; //get number of options in parent
 if Index < PreOptionCount then              //an option in the parent class?
  inherited SetOption(Index, Value)            //forward to parent's method
 else
  case Index - PreOptionCount of               //depending on index of option
    0: FDontOverrideCSSFile := Value.BoolData;   //set the value
    1: FTextHeaderFile := Value.StrData;
    2: FTextFooterFile := Value.StrData;
    3: FCharacterEncoding := Value.StrData;
    4: FDontQuoteSpecialCharacters := Value.BoolData;
  else
   assert(Index >= GetOptionCount);
   raise EInvalidOption.Create('Invalid index for option supplied!');
  end;
end;























{Returns the text formatted in the format of the documentation. Any special
 characters are encoded so the text will appear as is.
~param Text the text to "quote" in the format
~result the encoded text }
function TBaseHTMLDoc.HandleRawText(const Text: String): String;
var      p           :PChar;      //runner through the text
         LineBreak   :Boolean;    //if line breaks should be kept
begin
 Result := '';                    //no text encoded so far
 if Text <> '' then               //text not empty?
  begin
   LineBreak := KeepRawLineBreaks;  //get if line breaks should be kept
   p := Pointer(Text);
   while p^ <> #0 do                //for each character in the text
    begin
     case p^ of                       //encode any special HTML characters
       #10: if LineBreak then
             Result := Result + #10'<br>'  //treat new-line as a new-line
            else
             Result := Result + #10;       //just add the character
       '<': Result := Result + '&lt;';
       '>': Result := Result + '&gt;';
       '&': Result := Result + '&amp;';
       '"': Result := Result + '&quot;';
     else
      Result := Result + p^;          //just append all other characters
     end;
     inc(p);                        //next character
    end; //while p^ <> #0
  end; //if Text <> ''
end;



{Returns the text (formatted) of a comment in the format of the documentation.
 Any special characters are encoded for the used format.
 ~[preformatted
 <ul>
   <li>This is:</li>
   <li>A test for raw html code!</li>
   <li>a simple enumeration</li>
 </ul> ]
~param Text the text of a comment to "quote"
~result the quoted text }
function TBaseHTMLDoc.HandleRawCommentText(const Text: String): String;
begin
 if not FDontQuoteSpecialCharacters then  //normal encoding needed?
  Result := HandleRawText(Text)             //encode special characters
 else
  if KeepRawLineBreaks then        //line breaks should nevertheless be kept?
   Result := StringReplace(Text, #10, #10'<br>', [rfReplaceAll]) //create them
  else
   Result := Text;                   //just return the text unencoded
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 TBaseHTMLDoc.FormatText(TextFormat: TDocumentationTextFormat;
                                 const Text: String;
                                 var SkipWhitespaces: Boolean): String;
var      RealText    :String;          //the text to be formatted
//var      i           :Integer;         //positions of the tags
begin
 //new lines are already added, but will be kept anyway?
 if (TextFormat in [dtfPreFormatted, dtfSample]) and KeepRawLineBreaks then
  begin                                  //so they must be removed again
   RealText := StringReplace(Text, '<br>', '', [rfReplaceAll]);
{
   i := pos('<br>', Text);               //find first explicit line break
   while i <> 0 do                       //while line breaks found
    begin
     Delete(Text, i, 4);                   //remove it
     i := SearchString('<br>', Text, i);   //find the next
    end;
}
  end
 else
  RealText := Text;

 //format the text accordingly
 Result := inherited FormatText(TextFormat, RealText, SkipWhitespaces);
end;









{Gets the (internal) identification (for links) of topics of documentation of a
 GUI.
~param FileIndex  the index of the file
~param TopicIndex the index of the topic in the file;
                  -2 for the default topic or -1 for the file itself
~result the identification (internal URI) of the topic }
function TBaseHTMLDoc.GetGUIHelpURIByIndex(FileIndex,
                                           TopicIndex: Integer): String;
begin
 //get URI of the documentation of the file
 Result := TOldGUIHelpData(GUIHelpReader.GUIHelpData[FileIndex]).BaseName +
           '.html';
 if TopicIndex <> -1 then               //URI of topic searched?
  if TopicIndex = -2 then                 //is default topic?
   Result := Result + '#X.Default'          //use it
  else
   Result := Result + '#' +                 //append topic
             TOldGUIHelpData(GUIHelpReader.GUIHelpData[FileIndex]).
                                                      CommentNames[TopicIndex];
end;


{Gets the (internal) identification (for links) of pages in the user
 documentation.
~param PageIndex the number of the page (-1 for index)
~result the identification (internal URI) of the page }
function TBaseHTMLDoc.GetPageURI(PageIndex: Integer): String;
begin
 if PageIndex = -1 then                        //URI of the index requested?
  Result := 'index.html'                         //name of the index file
 else
  Result := Format('User_%d.html', [PageIndex]); //name of the file
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 TBaseHTMLDoc.InternalLink(const URI, LinkLabel: String): String;
var      LinkText    :String;         //the text being the link
begin
 if LinkLabel = '' then               //label is empty?
  LinkText := HandleRawText(URI)        //use the encoded URI
 else
  LinkText := LinkLabel;
 //return a link to the URI
 Result := Format('<a href="%s">%s</a>', [CodeURI(URI), LinkText]);
end;








{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 TBaseHTMLDoc.WriteImage(CharFormat, JPEGFormat: Boolean;
                                 Resolution: TPoint;
                                 BMP: TBitmap; const FileName: String;
                                 Links: TImageLinkList;
                                 const AlternativeText: String): String;
var      i           :Integer;   //counter through links
begin
{$IFDEF NOPNGSUPPORT}
 {$IFNDEF NOJPEGSUPPORT}
 JPEGFormat := True;
 {$ENDIF}
{$ENDIF}

{$IFDEF NOJPEGSUPPORT}
 {$IFNDEF NOPNGSUPPORT}
 JPEGFormat := False;
 {$ENDIF}
{$ENDIF}

 if JPEGFormat then
{$IFNDEF NOJPEGSUPPORT}
  //convert the screen shot to a JPEG file
  ConvertBMPToJPEG(BMP, FileName,
                   FDestPath +
                   ChangeFileExt(ExtractFileName(FileName), '.jpg'))
{$ELSE}
 AddPositionMessage(MakeDocMessagesID, Ord(mdmkNotSupported),
                    Format(DocumentationTexts[dtMustConvertImageManually].T,
                           [ChangeFileExt(ExtractFileName(FileName), '.jpg')]))
{$ENDIF}