📄 ubasehtmldoc.pas
字号:
else
{$IFNDEF NOPNGSUPPORT}
//convert the screen shot to a PNG file
ConvertBMPToPNG(BMP, FileName,
FDestPath + ChangeFileExt(ExtractFileName(FileName), '.png'))
{$ELSE}
AddPositionMessage(MakeDocMessagesID, Ord(mdmkNotSupported),
Format(DocumentationTexts[dtMustConvertImageManually].T,
[ChangeFileExt(ExtractFileName(FileName), '.png')]))
{$ENDIF}
;
if CharFormat then
Result := ''
else //start new paragraph and center image
Result := FNewLine + '<div align=center>' + FNewLine;
if Links.Count <> 0 then //image has some links?
//only one link on the whole image?
if (Links.Count = 1) and Links[0].IsAll then
//start a link on the whole image
Result := Result + '<a href="' + Links[0].LinkTarget + '">'
else
begin
inc(FImageMapIndex); //next image map
//start the image map
Result := Result + Format('<map name="imagemap%d">', [FImageMapIndex]);
for i := 0 to Links.Count - 1 do //for each link
with Links[i] do
if not IsAll then //if it is valid
Result := Result + '<area shape="rect" coords="' + //write it
Format('%d,%d,%d,%d',
[Position.Left, Position.Top,
Position.Right, Position.Bottom]) +
'" alt="' + AlternativeText +
'" title="' + AlternativeText +
'" href="' + LinkTarget + '">' + FNewLine;
Result := Result + '</map>'; //end the image map
if not CharFormat then //if not a as character
Result := Result + FNewLine; //format the source code prettier
end;
//start image tag
Result := Result + '<img src="' + GetImagePrefix(False);
if JPEGFormat then //write name of the file to use
Result := Result + ChangeFileExt(ExtractFileName(FileName), '.jpg')
else
Result := Result + ChangeFileExt(ExtractFileName(FileName), '.png');
//write the alternative text
Result := Result + '" alt="' + AlternativeText + '"';
//use image map if needed
if (Links.Count > 1) or ((Links.Count = 1) and not Links[0].IsAll) then
Result := Result + Format(' usemap="#imagemap%d"', [FImageMapIndex]);
Result := Result + ' border=0>'; //close image tag
//only one link on the whole image?
if (Links.Count = 1) and Links[0].IsAll then
Result := Result + '</a>'; //end link on the whole image
if not CharFormat then //end centered paragraph for the image
Result := Result + '</div>' + FNewLine;
end;
{Writes a GIF image in the given color.
~param Color the color to use, it's more like a boolean array for each
RGB value what color to use
~param FilePrefix base name of the file to create (without path and extension)
~param Portability if it is a image indicating a portability issue
~param Darker the value to darken the resulting image by }
procedure TBaseHTMLDoc.WriteGIFImage(Color: TColor; const FilePrefix: String;
Portability: Boolean; Darker: Byte = 0);
//the header of the image file (before the palette)
const GIFFileHeader = 'GIF89a'#$08#$00#$08#$00#$E3#$00#$00;
//the palette of the image file
// GIFFileColors = #$FF#$FF#$FF#$00#$00#$FF#$3F#$3F#$FF#$7F#$7F#$FF#$00#$00#$E0#$00#$00#$C0#$20#$20#$FF#$00#$00#$D0;
//the body of the image file (after the palette)
GIFFileBody = #$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$21#$F9#$04#$01#$0A#$00#$00#$00#$2C#$00#$00#$00#$00#$08#$00#$08#$00#$00#$04#$1D#$10#$C8#$10#$A4#$14#$94#$8A#$39#$06#$26#$00#$E5#$7D#$85#$26#$18#$C4#$51#$84#$54#$BA#$02#$82#$5B#$6C#$56#$F1#$02#$11#$00#$3B;
//the header of the image file (before the palette)
GIFPortFileHeader = 'GIF89a'#$08#$00#$08#$00#$E3#$00#$00;
//the palette of the image file
// GIFPortFileColors = #$FF#$FF#$FF#$00#$00#$FF#$3F#$3F#$FF#$7F#$7F#$FF#$00#$00#$E0#$00#$00#$C0#$20#$20#$FF#$00#$00#$00
//the body of the image file (after the palette)
GIFPortFileBody = #$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$21#$F9#$04#$01#$0A#$00#$08#$00#$2C#$00#$00#$00#$00#$08#$00#$08#$00#$00#$04#$1B#$10#$C9#$49#$D1#$39#$F5#$08#$81#$A5#$1E#$42#$80#$15#$01#$68#$10#$45#$71#$04#$2C#$AA#$AA#$57#$5C#$54#$53#$04#$00#$3B;
//number of entries in the palette of the image
PalSize = 8;
//an entry in the palette the value of a color component to use, if
//the color is R/G/B-value is activated or not
type TPaletteColorEntry = packed array[Boolean] of Char;
//for each palette entry the value to use, if the color component
//R/G/B is activated or not
const PalCols: array[Boolean] of array[0..PalSize-1] of TPaletteColorEntry =
(((#$FF, #$FF), (#$00, #$FF), (#$3F, #$FF), (#$7F, #$FF),
(#$00, #$E0), (#$00, #$C0), (#$20, #$FF), (#$00, #$D0)),
((#$FF, #$FF), (#$00, #$FF), (#$3F, #$FF), (#$7F, #$FF),
(#$00, #$E0), (#$00, #$C0), (#$20, #$FF), (#$00, #$00)));
var F :TextFile; //the file to write
i :Integer; //counter through the palette
R, G, B :Boolean; //if R/G/B-value is activated
NoYes :TPaletteColorEntry; //the R/G/B-values to use
begin
AssignFile(F, FDestPath + FilePrefix + '.gif');
Rewrite(F); //open the file
try
if Portability then //write the header of the image
Write(F, GIFPortFileHeader)
else
Write(F, GIFFileHeader);
R := (Color and $FF) <> 0; //get what color component R/G/B
G := (Color and $FF00) <> 0; //should be set
B := (Color and $FF0000) <> 0;
//for each palette entry
for i := low(PalCols[Portability]) to high(PalCols[Portability]) do
begin
NoYes := PalCols[Portability][i]; //get its color values
if ord(NoYes[True]) < Darker then //darken it
NoYes[True] := #$00
else
dec(NoYes[True], Darker);
Write(F, NoYes[R], NoYes[G], NoYes[B]); //write the palette entry
end;
if Portability then //write the body of the image
Write(F, GIFPortFileBody)
else
Write(F, GIFFileBody); //write the body of the image
finally
CloseFile(F); //close the file
end;
end;
{Writes a GIF image indicating an abstract method.
~param FilePrefix base name of the file to create (without path and extension) }
procedure TBaseHTMLDoc.WriteGIFImageAbstract(const FilePrefix: String);
//the header of the image file (before the palette)
const GIFFileHeader = 'GIF89a'#$08#$00#$08#$00#$E3#$00#$00;
//the palette of the image file
GIFFileColors = #$FF#$FF#$FF#$FF#$00#$00#$FF#$3F#$3F#$FF#$7F#$7F#$E0#$00#$00#$C0#$00#$00#$FF#$20#$20#$D0#$00#$00;
//the body of the image file (after the palette)
GIFFileBody = #$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$21#$F9#$04#$01#$0A#$00#$08#$00#$2C#$00#$00#$00#$00#$08#$00#$08#$00#$00#$04#$1F#$10#$49#$11#$A4#$1C#$E2#$84#$20#$66#$31#$48#$40#$20#$19#$28#$11#$C4#$66#$65#$45#$58#$B1#$13#$71#$14#$C5#$68#$11#$AD#$14#$01#$00#$3B;
var F :TextFile; //the file to write
begin
AssignFile(F, FDestPath + FilePrefix + '.gif');
Rewrite(F); //open the file
try
Write(F, GIFFileHeader); //write header of the image
Write(F, GIFFileColors); //write its palette
Write(F, GIFFileBody); //write the body of the image
finally
CloseFile(F); //close the file
end;
end;
{Write the redefined header of a HTML file, replacing special strings with
others.
~param F the file variable to write the header to
~param TitlePart the title of the HTML page
~param KeyWords the keywords of the HTML page in the index
~param MainPath path to the main directory of the documentation }
procedure TBaseHTMLDoc.WriteFileHeader(var F: TextFile;
const TitlePart, KeyWords,
MainPath: String);
{Replaces occurrences of one string by another.
~param Text the text to replace some text in
~param Search the text to search and replace
~param Replace the text to replace the other string with }
function Replace(const Text, Search, Replace: String): String;
var Start :Integer; //index to search text to replace from
Index :Integer; //index of text to be replaced
begin
Result := Text;
Start := 1; //start the scan at the beginning
repeat
Index := SearchString(Search, Result, Start); //search the text
if Index <> 0 then //found?
begin
Result := Copy(Result, 1, Index - 1) + //replace the text
Replace +
Copy(Result, Index + Length(Search), High(Length(Result)));
Start := Index + Length(Replace); //search after it
end;
until Index = 0; //until all occurrences have been replaces
end;
begin
assert(FTextHeaderFile <> '');
//replace all special tags and write the header
WriteLn(F, Replace(Replace(Replace(Replace(FTextHeader,
HeaderReplaceTitle, TitlePart),
HeaderReplaceKeyWords,
HandleRawText(KeyWords)),
HeaderReplacePathToMain, MainPath),
HeaderReplaceCharacterEncoding, FCharacterEncoding));
end;
{Returns the token of a string (formatted) in the format of the documentation.
It is formatted via CSS, its format may be altered in the CSS file.
~param StringToken the string token
~result the encoded string token in a special format }
function TBaseHTMLDoc.FormatStringToken(const StringToken: String): String;
begin
Result := '<span class=string>' + HandleRawText(StringToken) + '</span>';
end;
{Encodes special characters of external URIs.
~param Text the URI to encode
~result the encoded URI }
function TBaseHTMLDoc.CodeURI(const Text: String): String;
var p :PChar; //runner through the URI
begin
Result := ''; //nothing encoded so far
if Text <> '' then //URI not empty?
begin
p := Pointer(Text);
while p^ <> #0 do //for each character
begin
if p^ in ['A'..'Z', 'a'..'z', '0'..'9', //is a valid HTML character?
'_', '/', ':', '@', '.', ';', '#', '?', '+', '-', '%'] then
Result := Result + p^ //just add it
else
Result := Result + Format('%%%.2X', [Ord(p^)]); //encode it hexadecimal
inc(p); //next character
end;
end;
end;
{Returns a prefix for all links to images. Needed in order to use
sub-directories.
~param IsSymbol if the image is a symbol
~result a prefix for all links to images }
function TBaseHTMLDoc.GetImagePrefix(IsSymbol: Boolean): String;
begin
Result := '';
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 TBaseHTMLDoc.GetScope(Scope: TScope): String;
//the base names of all icons of the scopes
const ScopeFileName: array[TScope] of String =
('', 'unitinterface', 'unitlocal',
'private', 'protected', 'public', 'published', 'automated',
'');
begin
Result := ScopeFileName[Scope]; //get name of file of the scope
if Result <> '' then //icon available?
//return the code for including the image
Result := '<img src="' + GetImagePrefix(True) + Result + '.gif" alt="' +
Localize(ScopeTextMapping[Scope]) + '" title="' +
Localize(ScopeTextMapping[Scope]) + '">';
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 TBaseHTMLDoc.GetPortabilityIssues(Issues: TIdentPortabilities): String;
//the base names of all icons of portability issues
const IdentPortabilityFileName: array[TIdentPortability] of String =
('deprecated', 'library', 'platform');
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 code for including the image
Result := Result + '<img src="' + GetImagePrefix(True) +
IdentPortabilityFileName[p] + '.gif" alt="' +
IdentPortabilityFileName[p] + '" title="' +
IdentPortabilityFileName[p] + '">';
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -