uhtmlhelpdoc.pas

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

         Desc.Name := 'FileName';
         Desc.Category := '';
         Desc.Description := 'The name of the HTML Help file to be generated.';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := DefaultCHMFileName;
        end;
     3: begin
         Desc.Name := 'UseSubdirectories';
         Desc.Category := 'Generation';
         Desc.Description := 'Spread the source HTML files in several sub-directories?';
         Desc.DataType := otEnumeration;
         Desc.EnumNames := OptionItemsUseSubdirectories;
         Desc.DefaultValue.EnumData := 0;
        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 THTMLHelpDoc.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.StrData := FHelpCompilerPath;     //get the value
     1: Result.BoolData := FAutoCompile;
     2: Result.StrData := FHelpFileName;
     3: Result.EnumData := ord(FUseSubdirectories);
   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 THTMLHelpDoc.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: FHelpCompilerPath := Value.StrData;       //set the value
    1:
{$IFNDEF LINUX}
       FAutoCompile := Value.BoolData
{$ENDIF}
       ;
    2: FHelpFileName := Trim(Value.StrData);
    3: if (Value.EnumData >= ord(low(TSubDirectoryUsage))) and
          (Value.EnumData <= ord(high(TSubDirectoryUsage))) then
        FUseSubdirectories := TSubDirectoryUsage(Value.IntData);
  else
   assert(Index >= GetOptionCount);
   raise EInvalidOption.Create('Invalid index for option supplied!');
  end;
end;





{Returns the capabilities of this class of the generators.
~result the capabilities of this class of the generators }
class function THTMLHelpDoc.Capabilities: TGeneratorCapabilities;
begin
 Result := inherited Capabilities + [gcGUIHelp];
end;









{Returns the unique ID of an identifier to be used in the documentation, for
 instance to create a link to it.
~param Ident   the identifier to return a link to (may be nil, to return a link
               to the file)
~param TheFile the file the identifier is defined in
~result the unique ID of the identifier }
function THTMLHelpDoc.GetURIOf(Ident: TIdentifier;
                               TheFile: TPascalFile = nil): String;
var      TheRecord   :TRecordType;     //the record-like type to link to
         LinkRecord  :TRecordType;     //the record-like type to link from
begin
 if FUseSubdirectories <> sduNone then //uses sub-directories?
  begin
   assert(assigned(Ident) <> assigned(TheFile));
   assert(not DoNotDocumentIdentifier(Ident, TheFile));

   if assigned(Ident) then
    begin
     TheFile := Ident.InFile;
     if Ident is TRecordType then
      TheRecord := TRecordType(Ident)
     else
      TheRecord := Ident.MemberOf;
    end
   else
    TheRecord := nil;

   if assigned(LinkIdent) then
    if LinkIdent is TRecordType then
     LinkRecord := TRecordType(LinkIdent)
    else
     LinkRecord := LinkIdent.MemberOf
   else
    LinkRecord := nil;



   //currently in a sub-directory and another one?
   if assigned(LinkFile) and (TheFile <> LinkFile) then
    Result := '../'                        //go back to the main directory
   else
    Result := '';
   //currently in a sub-directory and another one?
   if (FUseSubdirectories = sduFilesAndTypes) and
      (assigned(LinkRecord) and (TheRecord <> LinkRecord)) then
    Result := Result + '../';              //go back/up one directory


   if TheFile <> LinkFile then           //another file, need sub-directory?
    begin
     //the name of the file (and its number) as the sub-directory
     Result := Result + TheFile.InternalFileName;
     if TheFile.InternalNameIndex <> 0 then
      Result := Result + '.' + IntToStr(TheFile.InternalNameIndex);
     Result := Result + '/';
    end;

   if assigned(TheRecord) then           //if in record-like type
    if FUseSubdirectories <> sduFilesAndTypes then //should be in a directory?
     Result := Result + 'I_' + TheRecord.Name   //add prefix + record-like type
    else
     if TheRecord <> LinkRecord then
      Result := Result + TheRecord.Name + '/';    //add sub-directory

   //identifier in file/record-like type?
   if assigned(Ident) and (Ident <> TheRecord) then
    begin
     //is inside a record-like type?
     if assigned(TheRecord) and (FUseSubdirectories <> sduFilesAndTypes) then
      Result := Result + '.';                //add separating dot
     Result := Result + 'I_';              //add prefix and index and its name
     if Ident.InternalNameIndex <> 0 then
      Result := Result + IntToStr(Ident.InternalNameIndex);
     Result := Result + Ident.Name;
    end
   else
    if not assigned(TheRecord) then      //just the file?
     Result := Result + 'File'             //use always this name for the file
    else
     if FUseSubdirectories = sduFilesAndTypes then //just the type?
      Result := Result + 'Type'              //this name for record-like types
  end
 else
  Result := inherited GetURIOf(Ident, TheFile);   //use default URI

 //add the file extension ".html"
 Result := Result + '.html';
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 THTMLHelpDoc.GetPageURI(PageIndex: Integer): String;
begin
 Result := inherited GetPageURI(PageIndex); //get URI
 //in a sub-directory?
 if (FUseSubdirectories <> sduNone) and assigned(LinkFile) then
  begin
    Result := '../' + Result;                 //go back to main directory
   //currently in another sub-directory and need another one?
   if (FUseSubdirectories = sduFilesAndTypes) and assigned(LinkIdent) and
      (assigned(LinkIdent.MemberOf) or (LinkIdent is TRecordType)) then
    Result := '../' + Result;                   //go back another directory
  end;
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 THTMLHelpDoc.WriteImage(CharFormat, JPEGFormat: Boolean;
                                 Resolution: TPoint;
                                 BMP: TBitmap; const FileName: String;
                                 Links: TImageLinkList;
                                 const AlternativeText: String): String;
begin
 inc(FGeneratedFileCount);             //count the image files

 //write the image
 Result := inherited WriteImage(CharFormat, JPEGFormat, Resolution,
                                BMP, FileName, Links, AlternativeText);
end;





























{Creates a new HTML file and writes its header.
~param F         the file variable to open the file with
~param FileName  the name of the file to create
~param TitlePart the title of the HTML page
~param KeyWords  the keywords of the HTML page in the index }
procedure THTMLHelpDoc.CreateFile(var F: TextFile;
                                  const FileName, TitlePart, KeyWords: String);
var       RealPath    :String;         //path using platform's path-delimiter
          KeyStr      :String;         //all keywords
          i           :Integer;        //general index and counter
          DirPath     :String;         //path of the file
          MainPath    :String;         //path to the main directory
begin
 assert((FUseSubdirectories <> sduNone) or
        ((pos(PathDelimiter, FileName) = 0) and (pos('/', FileName) = 0)));

 RealPath := FileName;

 MainPath := '';
 if FUseSubdirectories <> sduNone then //uses sub-directories?
  begin
   DirPath := ExtractFilePath(RealPath); //extract path component
   i := LastPos('/', RealPath);
   if i > Length(DirPath) then
    DirPath := Copy(RealPath, 1, i);

   if DirPath <> '' then                 //is in a sub-directory?
    begin
     if PathDelimiter <> '/' then          //path-delimiter isn't "/" ?
      for i := 1 to Length(DirPath) do       //adjust path delimiter
       if RealPath[i] = '/' then
        RealPath[i] := PathDelimiter;
     for i := 1 to Length(DirPath) do      //count level of directories
      if DirPath[i] = '/' then
       MainPath := MainPath + '../';       //go up another directory
     assert((MainPath = '../') or (MainPath = '../../'));

     //get absolute path
     DirPath := GetAbsolutePathCurrent(FDestPath + DirPath);
     if not DirectoryExists(DirPath) then  //directory does not exist?
      if not CreateDir(DirPath) then         //create it
       //if it couldn't be created, try creating its parent directories
       ForceDirectories(DirPath);
    end;
  end;


 inc(FGeneratedFileCount);             //another file generated

 AssignFile(F, FDestPath + RealPath + '.html');
 Rewrite(F);                           //open the file
 try
//   if FProjectName <> '' then          //name of project defined?
    //append it to the title
//    TitlePart := TitlePart + ' - ' + HandleRawText(FProjectName);

   KeyStr := KeyWords;
   for i := 1 to Length(KeyStr) do     //translate all ";" to ","
    if KeyStr[i] = ';' then
     KeyStr[i] := ',';

   if TextHeaderFile <> '' then        //custom header supplied?
    WriteFileHeader(F, TitlePart, KeyStr, MainPath)   //write it
   else
    begin
     WriteLn(F, DTD_Text);                 //write the DTD of the file
     WriteLn(F, '<html>');
     WriteLn(F, '<head>');
     WriteLn(F, '  <meta http-equiv="Content-Type" content="text/html; charset=',
                CharacterEncoding, '">');
     WriteLn(F, '  <meta http-equiv="Content-Style-Type" content="text/css">');
     WriteLn(F, '  <title>', TitlePart, '</title>');  //write title of the page
     if KeyWords <> '' then
      WriteLn(F, '  <meta name="keywords" content="', HandleRawText(KeyStr),
                 '">');
     //include the CSS file
     WriteLn(F, '  <link rel="stylesheet" type="text/css" href="', MainPath,
                CSSFileName, '" title="Style">');
     WriteLn(F, '</head>');
     WriteLn(F, '<body>');
    end;

   if KeyWords <> '' then              //key words specified?
    begin                                //start object to define key words
     WriteLn(F, '  <object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">');

     KeyStr := KeyWords;
     i := pos(';', KeyStr);              //get separator of key words
     while i <> 0 do                     //list of multiple key words?
      begin
       WriteLn(F, '    <param name="Keyword" value="',  //write next key word
                  copy(KeyStr, 1, i - 1), '">');
       Delete(KeyStr, 1, i);               //remove it from the list
       KeyStr := TrimLeft(KeyStr);         //remove leading spaces
       i := pos(';', KeyStr);              //get next separator
      end;

     //write the (last) key word
     WriteLn(F, '    <param name="Keyword" value="', KeyStr, '">');

     WriteLn(F, '  </object>');          //end object to define key words
    end;

   if InUserDoc then                //for user documentation
    WriteLn(F, '<h1>', TitlePart, '</h1>');    //write the title of the page

 except                             //in case of an error