unit UWriter; {$mode objfpc}{$H+} interface uses Classes, SysUtils, UFilter, crt, fgl, htmlelements; type TWriter = class public procedure WriteContent(AContent: String; AHighlights: THighlights); virtual; abstract; end; TWriterList = specialize TFPGObjectList; { TConsoleWriter } TConsoleWriter = class(TWriter) public procedure WriteContent(AContent: String; AHighlights: THighlights); override; end; { THTMLWriter } THTMLWriter = class(TWriter) protected FFileStream: TFileStream; procedure WriteLine(AContent: String); public constructor Create(AFileName: String); destructor Destroy; override; procedure WriteContent(AContent: String; AHighlights: THighlights); override; end; implementation const htmlColors: array[0..15] of String[6] = ( '000000', '000066', '003300', '0099CC', '990000', '990033', '663300', 'CCCCCC', '666666', '66CCFF', '66FF66', '99FFCC', 'FF8080', 'FF80B2', 'FFFF00', 'FFFFFF' ); cssColors: array[0..15] of String = ( 'Black', 'Blue', 'Green', 'Cyan', 'Red', 'Magenta', 'Brown', 'LightGray', 'DarkGray', 'LightBlue', 'LightGreen', 'LightCyan', 'LightRed', 'LightMagenta', 'Yellow', 'White' ); { THTMLWriter } procedure THTMLWriter.WriteLine(AContent: String); begin AContent := AContent + LineEnding; FFileStream.Write(AContent[1], Length(AContent)); end; constructor THTMLWriter.Create(AFileName: String); begin FFileStream := TFileStream.Create(AFileName, fmCreate); WriteLine(''); WriteLine(''); end; destructor THTMLWriter.Destroy; begin WriteLine(''); WriteLine(''); FFileStream.Free; inherited Destroy; end; procedure THTMLWriter.WriteContent(AContent: String; AHighlights: THighlights); var matchPos, offset, lastPos: Integer; highlight: THighlight; htmlContent, style: String; begin lastPos := 1; htmlContent := ''; for highlight in AHighlights do begin matchPos := highlight.Start; offset := highlight.Length; htmlContent := htmlContent + EscapeHTML(Copy(AContent, lastPos, matchPos - lastPos)); style := ''; if highlight.FGColor < 16 then style := 'color: ' + cssColors[highlight.FGColor] + ';'; if highlight.BGColor < 15 then style := style + 'background-color: ' + cssColors[highlight.BGColor] + ';'; if style <> '' then htmlContent := htmlContent + ''; htmlContent := htmlContent + EscapeHTML(Copy(AContent, matchPos, offset)); if style <> '' then htmlContent := htmlContent + ''; lastPos := matchPos + offset; end; htmlContent := htmlContent + EscapeHTML(Copy(AContent, lastPos, Length(AContent))); WriteLine(htmlContent + '
'); end; { TConsoleWriter } procedure TConsoleWriter.WriteContent(AContent: String; AHighlights: THighlights ); var matchPos, offset, lastPos: Integer; highlight: THighlight; begin lastPos := 1; for highlight in AHighlights do begin matchPos := highlight.Start; offset := highlight.Length; write(Copy(AContent, lastPos, matchPos - lastPos)); if highlight.FGColor < $FF then TextColor(highlight.FGColor); if highlight.BGColor < $FF then TextBackground(highlight.BGColor); write(Copy(AContent, matchPos, offset)); NormVideo; lastPos := matchPos + offset; end; writeln(Copy(AContent, lastPos, Length(AContent))); end; end.