unit beHTML;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics;
type
THTMLHeader = (h1, h2, h3, h4, h5);
THeaderColors = Array[THTMLHeader] of TColor;
THTMLDocument = class
private
FLines: TStrings;
FRawMode: Boolean;
FIndent: Integer;
function Indent: String;
function Raw(const AText: String): String;
function ColorToHTML(AColor: TColor): String;
public
constructor Create;
destructor Destroy; override;
procedure AddEmptyLine;
procedure AddListItem(const AText: String);
procedure AddHeader(AHeader: THTMLHeader; const AText: String);
procedure AddParagraph(const AText: String);
procedure BeginDocument(const ATitle: String; const AHeaderColors: THeaderColors;
ARawMode: Boolean=false);
procedure BeginBulletList;
procedure BeginNumberedList;
function Bold(const AText: String): String;
procedure EndDocument;
procedure EndBulletList;
procedure EndNumberedList;
function Hyperlink(const AText, ALink: String): String;
function Italic(const AText: String): String;
property Lines: TStrings read FLines;
end;
implementation
uses
StrUtils, LCLIntf;
constructor THTMLDocument.Create;
begin
inherited;
FLines := TStringList.Create;
end;
destructor THTMLDocument.Destroy;
begin
FLines.Free;
inherited;
end;
procedure THTMLDocument.AddHeader(AHeader: THTMLHeader; const AText: String);
begin
if FRawMode then
FLines.Add(Raw(AText))
else
FLines.Add(Format('%s%s', [Indent, ord(AHeader)+1, AText, ord(AHeader)+1]));
end;
(*
Title appears in the browser's title bar...
Heading goes here...
Enter your paragraph text here...
*)
procedure THTMLDocument.BeginDocument(const ATitle: String;
const AHeaderColors: THeaderColors; ARawMode: Boolean = false);
begin
FRawMode := ARawMode;
FLines.Clear;
if not FRawMode then begin
FLines.Add('');
FLines.Add('');
FLines.Add(' ');
FLines.Add(' ');
FLines.Add(' ' + ATitle + '');
FLines.Add(' ');
FLines.Add(' ');
FLines.Add(' ');
FIndent := 4;
end;
end;
procedure THTMLDocument.BeginBulletList;
begin
if not FRawMode then begin
FLines.Add(Indent + '');
inc(FIndent, 2);
end;
end;
procedure THTMLDocument.BeginNumberedList;
begin
if not FRawMode then begin
FLines.Add(Indent + '');
inc(FIndent, 2);
end;
end;
procedure THTMLDocument.AddEmptyLine;
begin
if FRawMode then
FLines.Add('')
else
FLines.Add('
');
end;
procedure THTMLDocument.AddListItem(const AText: String);
begin
if FRawMode then
FLines.Add('- ' + Raw(AText))
else
FLines.Add(Indent + '- ' + AText + '
');
end;
procedure THTMLDocument.AddParagraph(const AText: String);
begin
if FRawMode then
FLines.Add(Raw(AText))
else
FLines.Add(Indent + '' + AText + '
');
end;
function THTMLDocument.Bold(const AText: String): String;
begin
if FRawMode then
Result := AText
else
Result := '' + AText + '';
end;
function THTMLDocument.ColorToHTML(AColor: TColor): String;
var
tmpRGB: LongInt;
begin
tmpRGB := ColorToRGB(AColor) ;
Result := Format('#%.2x%.2x%.2x', [
GetRValue(tmpRGB),
GetGValue(tmpRGB),
GetBValue(tmpRGB)
]) ;
end;
procedure THTMLDocument.EndDocument;
begin
if not FRawMode then begin
FLines.Add(' ');
FLines.Add('');
end;
end;
procedure THTMLDocument.EndBulletList;
begin
if not FRawMode then begin
dec(FIndent, 2);
FLines.Add(Indent + '
');
end;
end;
procedure THTMLDocument.EndNumberedList;
begin
if not FRawMode then begin
dec(FIndent, 2);
FLines.Add(Indent + '');
end;
end;
function THTMLDocument.Hyperlink(const AText, ALink: String): String;
begin
if FRawMode then
Result := Format('%s (%s)', [AText, ALink])
else
Result := Format('%s', [ALink, AText]);
end;
function THTMLDocument.Indent: String;
begin
Result := DupeString(' ', FIndent);
end;
function THTMLDocument.Italic(const AText: String): String;
begin
if FRawMode then
Result := AText
else
Result := '' + AText + '';
end;
function THTMLDocument.Raw(const AText: String): String;
var
i, n: Integer;
begin
Result := '';
if AText = '' then
exit;
n := Length(AText);
i := 1;
while (i <= n) do begin
if AText[i] = '<' then
repeat
inc(i);
until (i = n) or (AText[i] = '>')
else
Result := Result + AText[i];
inc(i);
end;
end;
end.