转换Pascal代码为HTML
// The ConvertDelphiToHTML procedure Converts
// Dephi and Pascal code to HTML with CSS.
// Copyright (c) 2004 Koen Rutten
// This is free software.
// You can freely use and redistribute this software in any
// way you like. You can modify and use the sourcecode if
// the resulting code and product both contain a notice
// that explain that my part of the code was created by me.
const
NewLine = #13#10; // windows-newlines
procedure ConvertDelphiToHTML(
const Code: string;
var HTML, CSS: string;
const CSSMain, CSSComment,
CSSString, CSSNumber: string
);
type
TCodeState = (
CSNormal,
CSCommentLine,
CSCommentBlock,
CSString,
CSNumber
);
// returns true is the character is a whitespace or
// control caracter, or a symbol.
// words are separated by these.
function IsControl(c: char): boolean;
begin
result := not (c in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
end;
var
i, l: integer; // Index in an length of Input Code
c: Char; // The current character being parsed
pc: Char; // The previous character being parsed
CodeState: TCodeState; // The current parsing state
Word: string; // (part of) the current word
InWord: Boolean; // are we parsing a word?
// returns true if the word is a known keyword
function IsKeyword(word: string): boolean;
const
keywords: array[0..75] of string = (
// From Delphi 7 helpfile:
'and', 'array', 'as', 'asm',
'begin', 'case', 'class', 'const',
'constructor', 'destructor', 'dispinterface', 'div',
'do', 'downto', 'else', 'end',
'except', 'exports', 'file', 'finalization',
'finally', 'for', 'function', 'goto',
'if', 'implementation', 'in', 'inherited',
'initialization', 'inline', 'interface', 'is',
'label', 'library', 'mod', 'nil',
'not', 'object', 'of', 'or',
'out', 'packed', 'procedure', 'program',
'property', 'raise', 'record', 'repeat',
'resourcestring', 'set', 'shl', 'shr',
'string', 'then', 'threadvar', 'to',
'try', 'type', 'unit', 'until',
'uses', 'var', 'while', 'with',
'xor', 'private', 'protected', 'public',
'published', 'automated', 'on',
// From 'Calling conventions' in the help:
'register', 'pascal', 'cdecl', 'stdcall', 'safecall'
);
l = length(keywords);
var
i: integer;
begin
result := true;
for i := 0 to l - 1 do
if LowerCase(word) = keywords[i] then exit;
result := false;
end; // function IsKeyword
// Called if the begin of a word is found.
procedure BeginWord;
begin
InWord := true;
Word := '';
end;
// Called if the end of a word is found
// Adds the word to the output
procedure EndWord;
begin
InWord := false;
if IsKeyword(Word) then
HTML := HTML + '<b>' + Word + '</b>'
else
HTML := HTML + Word
;
end;
// If a word is being parsed, the character is added to
// the word, else it is added to the output.
// Converts &, < and > to html.
procedure AddChar;
begin
if InWord then begin
if CodeState = CSNormal then begin
Word := Word + c;
exit;
end else begin
EndWord;
end;
end;
case c of
'&': HTML := HTML + '&';
'<': HTML := HTML + '<';
'>': HTML := HTML + '>';
else HTML := HTML + c;
end; // case
end; //procedure AddChar
// outputs the start of a span
procedure StartSpan(const CSSClass: string);
begin
HTML := HTML + '<span class="' + CSSClass + '">';
end;
// outputs the end of a span
procedure EndSpan;
begin
HTML := HTML + '</span>';
end;
procedure GoNormal;
begin
EndSpan;
CodeState := CSNormal;
end;
begin
l := length(Code);
// Create the HTML-code:
// <pre> is an official HTML 4.0 element
HTML := '<pre class="' + CSSMain + '">' + NewLine;
//start-values
InWord := false;
CodeState := CSNormal;
i := 0;
c := #0; // So pc wil be #0 in the first loop
//simply loop trough the input string head to tail
while i < l do begin
inc(i);
pc := c;
c := Code[i]; // get the char
case CodeState of // parse it dependent on de CodeState
// we are in 'normal' code
// many things can happen here.
CSNormal: begin
case c of
// start of a number
'0'..'9', '#', '$': begin
if IsControl(pc) then begin
startSpan(CSSNumber);
CodeState := CSNumber;
end;
addChar;
end;
// start of a string
'''': begin
startSpan(CSSString);
CodeState := CSString;
addChar;
end;
// start of a comment-block
'{': begin
startSpan(CSSComment);
CodeState := CSCommentBlock;
addChar;
end;
// if the current and the previous char are a /,
// we found the beginning of a comment-line,
// but we already added the first /. We delete it
// to add it again after the comment-span start.
// It's not an elegant solutions, but it works ...
'/': begin
if pc = '/' then begin
setLength(HTML, length(HTML) - 1);
startSpan(CSSComment);
CodeState := CSCommentLine;
addChar;
end;
addChar;
end;
// normal code, possibly the start of a word,
// or the end
else begin
if IsControl(pc) then begin
if not IsControl(c) then BeginWord;
end;
if InWord and IsControl(c) then EndWord;
AddChar;
end;
end; // case c of
end;
// we are in a commented line (part) ( //.. )
// the only escape is the end of the line
CSCommentLine: begin
if (c = #10) or (c = #13) then GoNormal;
AddChar;
end;
// we are in a commented block ( {..} )
// the only escape is a }
CSCommentBlock: begin
addChar;
if c = '}' then GoNormal;
end;
// we are in a string ( '..' )
// the only escape is another '
// an end of line would not be valid pascal or delphi
// code, so we ignore it.
CSString: begin
addChar;
if c = '''' then GoNormal;
end;
// we are in a number ( #$0123456789 )
// the only escape is a white, control or symbol
// another char (A..Z,a..z, enz) would be invalid code
CSNumber: begin
if c in ['0' .. '9'] then begin
addChar;
end else begin
GoNormal;
dec(i); // parse the character again as normal
end;
end;
end; // case CodeState of
end; // while i < l do begin
// The code could end with a word, if so we must end it
if InWord then EndWord;
// Valid code could end with //.., so we need this:
if not (CodeState = CSNormal) then GoNormal;
HTML := HTML + '</pre>' + NewLine;
// Create the CSS-styles:
// You can change this if you want different colors/fonts
CSS :=
'.' + CSSMain + ' {' + NewLine +
' background-color: #FFFFFF;' + NewLine +
' color: #000000;' + NewLine +
' padding: 4px;' + NewLine +
' font-family: "Courier New";' + NewLine +
'}' + NewLine +
NewLine +
'.' + CSSComment + ' {' + NewLine +
' color: #0000A0;' + NewLine +
' font-style: italic;' + NewLine +
'}' + NewLine +
NewLine +
'.' + CSSString + ' {' + NewLine +
' color: #00A000;' + NewLine +
'}' + NewLine +
NewLine +
'.' + CSSNumber + ' {' + NewLine +
' color: #A00000;' + NewLine +
'}' + NewLine ;
end; // procedure ConvertDelphiToHTML