lasarus_compotents/ATSynEdit/atsynedit/atsynedit_export_html.pas

133 lines
4.0 KiB
ObjectPascal

unit ATSynEdit_Export_HTML;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, StrUtils,
ATSynEdit,
ATSynEdit_CanvasProc,
ATStringProc_HtmlColor,
LazUTF8Classes;
procedure DoEditorExportToHTML(Ed: TATSynEdit;
const AFilename, APageTitle, AFontName: string;
AFontSize: integer; AWithNumbers: boolean;
AColorBg, AColorNumbers: TColor);
implementation
procedure DoEditorExportToHTML(Ed: TATSynEdit; const AFilename, APageTitle,
AFontName: string; AFontSize: integer; AWithNumbers: boolean; AColorBg,
AColorNumbers: TColor);
var
L: TStringListUTF8;
Parts: TATLineParts;
PPart: ^TATLinePart;
NColorFont: TColor;
NColorAfter: TColor;
NeedStyle: boolean;
Str0, Str1: string;
i, j: integer;
begin
NColorFont:= clBlack;
FillChar(Parts, Sizeof(Parts), 0);
if FileExists(AFilename) then
DeleteFile(AFilename);
L:= TStringListUTF8.Create;
try
L.Add('<!-- Generated by ATSynEdit Exporter -->');
L.Add('<html>'+sLineBreak+
'<head>'+sLineBreak+
' <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'+sLineBreak+
' <title>'+APageTitle+'</title>'+sLineBreak+
' <style>'+sLineBreak+
' body, table {'+sLineBreak+
' color: '+SColorToHtmlColor(NColorFont)+';'+sLineBreak+
' background-color: '+SColorToHtmlColor(AColorBg)+';'+sLineBreak+
' }'+sLineBreak+
' pre, code {'+sLineBreak+
' font-family: "'+AFontName+'", sans-serif;'+sLineBreak+
' font-size: '+IntToStr(AFontSize)+'px;'+sLineBreak+
' }'+sLineBreak+
' table, td {'+sLineBreak+
' border-style: hidden;'+sLineBreak+
' }'+sLineBreak+
' td {'+sLineBreak+
' vertical-align: top;'+sLineBreak+
' }'+sLineBreak+
' td.num {'+sLineBreak+
' color: '+SColorToHtmlColor(AColorNumbers)+';'+sLineBreak+
' text-align: right;'+sLineBreak+
' }'+sLineBreak+
' </style>'+sLineBreak+
'</head>'+sLineBreak+
'<body>');
if AWithNumbers then
begin
L.Add('<table>'+sLineBreak+'<tr>'+sLineBreak+'<td class="num">');
L.Add('<pre><code>'); //??? eol
for i:= 0 to Ed.Strings.Count-1 do
L.Add(IntToStr(i+1)+'&nbsp;&nbsp;');
L.Add('</code></pre>');
L.Add('</td>'+sLineBreak+'<td>');
end;
L.Add('<pre><code>');
for i:= 0 to Ed.Strings.Count-1 do
begin
Str0:= '';
if not Ed.DoCalcLineHiliteEx(i, Parts, AColorBG, NColorAfter) then break;
for j:= 0 to High(Parts) do
begin
PPart:= @Parts[j];
if PPart^.Len=0 then Break;
if PPart^.FontBold then Str0:= Str0+'<b>';
if PPart^.FontItalic then Str0:= Str0+'<i>';
if PPart^.FontStrikeOut then Str0:= Str0+'<s>';
NeedStyle:=
(PPart^.ColorFont<>NColorFont) or
(PPart^.ColorBG<>AColorBG);
if NeedStyle then
Str0:= Str0+'<span style="'+
IfThen(PPart^.ColorFont<>NColorFont, 'color: '+SColorToHtmlColor(PPart^.ColorFont)+'; ')+
IfThen(PPart^.ColorBG<>AColorBG, 'background: '+SColorToHtmlColor(PPart^.ColorBG)+'; ')+
'">';
Str1:= Utf8Encode(Copy(Ed.Strings.Lines[i], PPart^.Offset+1, PPart^.Len));
Str1:= StringReplace(Str1, '<', '&lt;', [rfReplaceAll]);
Str1:= StringReplace(Str1, '>', '&gt;', [rfReplaceAll]);
Str0:= Str0+Str1;
if NeedStyle then
Str0:= Str0+'</span>';
if PPart^.FontStrikeOut then Str0:= Str0+'</s>';
if PPart^.FontItalic then Str0:= Str0+'</i>';
if PPart^.FontBold then Str0:= Str0+'</b>';
end;
L.Add(Str0);
end;
L.Add('</code></pre>');
if AWithNumbers then
L.Add('</td></tr></table>');
L.Add('</body>');
L.Add('</html>');
L.SaveToFile(AFilename);
finally
FreeAndNil(L);
end;
end;
end.