Code:
unit SrcCnvU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, nldWebModuleU, HTTPApp, HTTPProd, nldPageProducer,
nldModuleDispatcher, SynEditExport, SynExportHTML, SynEditHighlighter,
SynHighlighterPas;
type
{ Source convert module }
TSrcCnv = class(TnldWebModule)
private
function HTMLToVBCode(Code: string): string;
protected
function Content: String; override;
end;
implementation
{$R *.dfm}
uses
JclStrings;
{ TSrcCnv }
function TSrcCnv.Content: String;
var
ALines: TStringList;
Syn: TSynPasSyn;
Exp: TSynExporterHTML;
S: TMemoryStream;
begin
S := TMemoryStream.Create;
ALines := TStringList.Create;
try
{ Component moet runtime worden aangemaakt, anders spontane AV }
Syn := TSynPasSyn.Create(nil);
try
with Syn do
begin
CommentAttri.Foreground := clNavy;
CommentAttri.Style := [];
KeyAttri.Foreground := clRed;
KeyAttri.Style := [];
NumberAttri.Foreground := clBlue;
StringAttri.Foreground := clBlue;
end;
ALines.Text := Request.ContentFields.Values['Code'];
{ Export in eerste instantie naar HTML, vBCode komt later }
Exp := TSynExporterHTML.Create(nil);
try
Exp.Highlighter := Syn;
Exp.ExportAsText := TRUE;
Exp.HTMLFontSize := fsDefault;
Exp.Title := 'NLDelphi, pascal naar HTML converter';
Exp.ExportAll(ALines);
Exp.SaveToStream(S);
S.Position := 0;
ALines.LoadFromStream(S);
Result := ALines.Text;
if Request.ContentFields.Values['type'] = 'vbcode' then
Result := HTMLToVBCode(Result);
finally
Exp.Free;
end;
finally
Syn.Free;
end;
finally
ALines.Free;
S.Free;
end;
end;
{ Vervang de HTML codes door VB codes }
function TSrcCnv.HTMLToVBCode(Code: string): string;
const
Max = 5;
Replace: array[0..Max] of array[0..1] of string =
(
('<code>', '[ CODE]'),
('</code>', '[ /CODE]'),
('<font face="Courier New">', ''),
('<font color="#FF0000">', '[ COLOR=red]'),
('<font color="#000080">', '[ COLOR=blue]'),
('</font>', '[ /COLOR]')
);
var
i: Integer;
begin
Result := Code;
for i := 0 to Max do
Result := StringReplace(Result, Replace[i, 0], Replace[i, 1],
[rfIgnoreCase, rfReplaceAll]);
{ Verwijder laatste [ /COLOR], dit is de afsluiting voor Courier }
Delete(Result, StrILastPos('[ /COLOR]', Result), 8);
end;
initialization
RegisterModule(TSrcCnv);
end.
Bookmarks