{------------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: SynExportHTML.pas, released 2000-04-16. The Original Code is partly based on the mwHTMLExport.pas file from the mwEdit component suite by Martin Waldenburg and other developers, the Initial Author of this file is Michael Hieke. Portions created by Michael Hieke are Copyright 2000 Michael Hieke. Portions created by James D. Jacobson are Copyright 1999 Martin Waldenburg. All Rights Reserved. Contributors to the SynEdit project are listed in the Contributors.txt file. Alternatively, the contents of this file may be used under the terms of the GNU General Public License Version 2 or later (the "GPL"), in which case the provisions of the GPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL. $Id$ You may retrieve the latest version of this file at the SynEdit home page, located at http://SynEdit.SourceForge.net Known Issues: -------------------------------------------------------------------------------} unit SynExportHTML; {$I synedit.inc} {.$define debug_synexporthtml} interface uses Classes, SysUtils, LCLIntf, LCLType, Graphics, ClipBrd, SynEditHighlighter, SynEditExport, LazUtf8, SynEditStrConst, LazEditTextAttributes; type THTMLFontSize = (fs01, fs02, fs03, fs04, fs05, fs06, fs07, fsDefault); //eb 2000-10-12 TExportHtmlOption = ( heoFragmentOnly, //no surrounding ... Note: will exclude heoDoctype, heoCharset heoDoctype, //add doctype declaration heoCharset, //add charset (UTF-8) information heoWinClipHeader //add Clipboard header (affects Windows only) Note: cannot be set if ExportAsText = True! ); TExportHtmlOptions = set of TExportHtmlOption; { TSynExporterHTML } TSynExporterHTML = class(TSynCustomExporter) private fOptions: TExportHtmlOptions; fFontSize: THTMLFontSize; procedure SetExportHtmlOptions(Value: TExportHtmlOptions); function GetCreateHTMLFragment: Boolean; procedure SetCreateHTMLFragment(Value: Boolean); function MakeFontSpan(FG, BG: TColor): String; function StyleToHtml(AStyle: TFontStyles; IsSpace, DoSet: Boolean): String; protected procedure FormatAfterLastAttribute; override; procedure FormatAttributeDone(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); override; procedure FormatAttributeInit(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); override; {begin} //mh 2000-10-10 procedure FormatBeforeFirstAttribute(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); override; {end} //mh 2000-10-10 procedure FormatBeforeFirstAttributeImmediate(BG, FG: TColor); override; procedure FormatAfterLastAttributeImmediate; override; procedure FormatAttributeInitImmediate(Attri: TLazCustomEditTextAttribute; IsSpace: Boolean); override; procedure FormatAttributeDoneImmediate(Attri: TLazCustomEditTextAttribute; IsSpace: Boolean); override; procedure FormatNewLine; override; function GetFooter: string; override; function GetFormatName: string; override; function GetHeader: string; override; procedure SetExportAsText(Value: boolean); override; public constructor Create(AOwner: TComponent); override; published property Color; property CreateHTMLFragment: boolean read GetCreateHTMLFragment write SetCreateHTMLFragment default FALSE; deprecated 'Use Options instead'; property DefaultFilter; property Options: TExportHtmlOptions read fOptions write SetExportHtmlOptions default [heoDoctype, heoCharset]; property Font; property Highlighter; property HTMLFontSize: THTMLFontSize read fFontSize write fFontSize; //eb 2000-10-12 property Title; property UseBackground; end; function ColorToHTML(AColor: TColor): string; implementation const DocType = ''; //cannot use strict, because we use tag Generator = ''; CharSet = ''; DocumentStart = ''+LineEnding+ ''+LineEnding+ '%s'+LineEnding+ ''+LineEnding+ ''; DocumentEnd = ''+LineEnding+''; CodeStart = '
';
  CodeEnd = '
'; FontStart = ''; FontEnd = ''; WinClipHeaderFmt = 'Version:0.9' + LineEnding + 'StartHTML:%.8d' + LineEnding + 'EndHTML:%.8d' + LineEnding + 'StartFragment:%.8d' + LineEnding + 'EndFragment:%.8d' + LineEnding; StartFragmentComment = ''; EndFragmentComment = ''; function ColorToHTML(AColor: TColor): string; var RGBColor: TColorRef; RGBValue: byte; const Digits: array[0..15] of char = '0123456789ABCDEF'; begin Result := ''; case AColor of clRed: Result := 'red'; clGreen: Result := 'green'; clBlue: Result := 'blue'; clPurple: Result := 'purple'; clYellow: Result := 'yellow'; clBlack: Result := 'black'; clWhite: Result := 'white'; clGray: Result := 'gray'; clMaroon: Result := 'maroon'; clFuchsia: Result := 'fuchsia'; clLime: Result := 'lime'; clNavy: Result := 'navy'; clAqua: Result := 'aqua'; clTeal: Result := 'teal'; clSilver: Result := 'silver'; end; if (Result <> '') then Exit; RGBColor := ColorToRGB(AColor); Result := '#000000'; {****************} RGBValue := GetRValue(RGBColor); if RGBValue > 0 then begin Result[2] := Digits[RGBValue shr 4]; Result[3] := Digits[RGBValue and 15]; end; {****************} RGBValue := GetGValue(RGBColor); if RGBValue > 0 then begin Result[4] := Digits[RGBValue shr 4]; Result[5] := Digits[RGBValue and 15]; end; {****************} RGBValue := GetBValue(RGBColor); if RGBValue > 0 then begin Result[6] := Digits[RGBValue shr 4]; Result[7] := Digits[RGBValue and 15]; end; end; { TSynExporterHTML } constructor TSynExporterHTML.Create(AOwner: TComponent); const HTML_Format = {$ifdef windows}'HTML Format'{$else}'text/html'{$endif}; begin inherited Create(AOwner); {**************} fClipboardFormat := RegisterClipboardFormat(HTML_Format); fFontSize := fs03; fOptions := [heoDocType, heoCharset]; fDefaultFilter := SYNS_FilterHTML; // setup array of chars to be replaced fReplaceReserved['&'] := '&'; fReplaceReserved['<'] := '<'; fReplaceReserved['>'] := '>'; //fReplaceReserved['"'] := '"'; //no need to replace this //fReplaceReserved[''''] := '''; //no need to replace this { The following characters are multi-byte in UTF-8: fReplaceReserved['™'] := '™'; fReplaceReserved['©'] := '©'; fReplaceReserved['®'] := '®'; fReplaceReserved['À'] := 'À'; fReplaceReserved['Á'] := 'Á'; fReplaceReserved['Â'] := 'Â'; fReplaceReserved['Ã'] := 'Ã'; fReplaceReserved['Ä'] := 'Ä'; fReplaceReserved['Å'] := 'Å'; fReplaceReserved['Æ'] := 'Æ'; fReplaceReserved['Ç'] := 'Ç'; fReplaceReserved['È'] := 'È'; fReplaceReserved['É'] := 'É'; fReplaceReserved['Ê'] := 'Ê'; fReplaceReserved['Ë'] := 'Ë'; fReplaceReserved['Ì'] := 'Ì'; fReplaceReserved['Í'] := 'Í'; fReplaceReserved['Î'] := 'Î'; fReplaceReserved['Ï'] := 'Ï'; fReplaceReserved['Ð'] := 'Ð'; fReplaceReserved['Ñ'] := 'Ñ'; fReplaceReserved['Ò'] := 'Ò'; fReplaceReserved['Ó'] := 'Ó'; fReplaceReserved['Ô'] := 'Ô'; fReplaceReserved['Õ'] := 'Õ'; fReplaceReserved['Ö'] := 'Ö'; fReplaceReserved['Ø'] := 'Ø'; fReplaceReserved['Ù'] := 'Ù'; fReplaceReserved['Ú'] := 'Ú'; fReplaceReserved['Û'] := 'Û'; fReplaceReserved['Ü'] := 'Ü'; fReplaceReserved['Ý'] := 'Ý'; fReplaceReserved['Þ'] := 'Þ'; fReplaceReserved['ß'] := 'ß'; fReplaceReserved['à'] := 'à'; fReplaceReserved['á'] := 'á'; fReplaceReserved['â'] := 'â'; fReplaceReserved['ã'] := 'ã'; fReplaceReserved['ä'] := 'ä'; fReplaceReserved['å'] := 'å'; fReplaceReserved['æ'] := 'æ'; fReplaceReserved['ç'] := 'ç'; fReplaceReserved['è'] := 'è'; fReplaceReserved['é'] := 'é'; fReplaceReserved['ê'] := 'ê'; fReplaceReserved['ë'] := 'ë'; fReplaceReserved['ì'] := 'ì'; fReplaceReserved['í'] := 'í'; fReplaceReserved['î'] := 'î'; fReplaceReserved['ï'] := 'ï'; fReplaceReserved['ð'] := 'ð'; fReplaceReserved['ñ'] := 'ñ'; fReplaceReserved['ò'] := 'ò'; fReplaceReserved['ó'] := 'ó'; fReplaceReserved['ô'] := 'ô'; fReplaceReserved['õ'] := 'õ'; fReplaceReserved['ö'] := 'ö'; fReplaceReserved['ø'] := 'ø'; fReplaceReserved['ù'] := 'ù'; fReplaceReserved['ú'] := 'ú'; fReplaceReserved['û'] := 'û'; fReplaceReserved['ü'] := 'ü'; fReplaceReserved['ý'] := 'ý'; fReplaceReserved['þ'] := 'þ'; fReplaceReserved['ÿ'] := 'ÿ'; fReplaceReserved['¡'] := '¡'; fReplaceReserved['¢'] := '¢'; fReplaceReserved['£'] := '£'; fReplaceReserved['¤'] := '¤'; fReplaceReserved['¥'] := '¥'; fReplaceReserved['¦'] := '¦'; fReplaceReserved['§'] := '§'; fReplaceReserved['¨'] := '¨'; fReplaceReserved['ª'] := 'ª'; fReplaceReserved['«'] := '«'; fReplaceReserved['¬'] := '­'; fReplaceReserved['¯'] := '¯'; fReplaceReserved['°'] := '°'; fReplaceReserved['±'] := '±'; fReplaceReserved['²'] := '²'; fReplaceReserved['³'] := '³'; fReplaceReserved['´'] := '´'; fReplaceReserved['µ'] := 'µ'; fReplaceReserved['·'] := '·'; fReplaceReserved['¸'] := '¸'; fReplaceReserved['¹'] := '¹'; fReplaceReserved['º'] := 'º'; fReplaceReserved['»'] := '»'; fReplaceReserved['¼'] := '¼'; fReplaceReserved['½'] := '½'; fReplaceReserved['¾'] := '¾'; fReplaceReserved['¿'] := '¿'; fReplaceReserved['×'] := '×'; fReplaceReserved['÷'] := '÷'; fReplaceReserved['€'] := '€';} end; procedure TSynExporterHTML.FormatAfterLastAttribute; begin if fsStrikeout in fLastStyle then AddData(''); if fsUnderline in fLastStyle then AddData(''); if fsItalic in fLastStyle then AddData(''); if fsBold in fLastStyle then AddData(''); if fLastFG <> fFont.Color then AddData(''); if UseBackground and (fLastBG <> fBackgroundColor) then AddData(''); end; procedure TSynExporterHTML.FormatAttributeDone(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); begin if BackgroundChanged or ForegroundChanged or (FontStylesChanged <> []) then begin if fsStrikeout in fLastStyle then AddData(''); if fsUnderline in fLastStyle then AddData(''); if fsItalic in fLastStyle then AddData(''); if fsBold in fLastStyle then AddData(''); end; if (BackgroundChanged or ForegroundChanged) and (fLastFG <> fFont.Color) then //mh 2000-10-10 AddData(''); if BackgroundChanged then AddData(''); end; procedure TSynExporterHTML.FormatAttributeInit(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); begin if BackgroundChanged then AddData(''); if BackgroundChanged or ForegroundChanged or (FontStylesChanged <> []) then begin if fsBold in fLastStyle then AddData(''); if fsItalic in fLastStyle then AddData(''); if fsUnderline in fLastStyle then AddData(''); if fsStrikeout in fLastStyle then AddData(''); end; end; {begin} //mh 2000-10-10 procedure TSynExporterHTML.FormatBeforeFirstAttribute(BackgroundChanged, ForegroundChanged: boolean; FontStylesChanged: TFontStyles); begin if BackgroundChanged then AddData(''); if FontStylesChanged <> [] then begin if fsBold in fLastStyle then AddData(''); if fsItalic in fLastStyle then AddData(''); if fsUnderline in fLastStyle then AddData(''); if fsStrikeout in fLastStyle then AddData(''); end; end; procedure TSynExporterHTML.FormatBeforeFirstAttributeImmediate(BG, FG: TColor); var Span: String; begin {$ifdef debug_synexporthtml} debugln(['TSynExporterHTML.FormatBeforeFirstAttributeImmediate']); {$endif} // if not heoFragmentOnly this is handled in GetHeader if (heoFragmentOnly in Options) then begin Span := MakeFontSpan(FG, BG); AddData(Span); end; end; procedure TSynExporterHTML.FormatAfterLastAttributeImmediate; begin {$ifdef debug_synexporthtml} debugln(['TSynExporterHTML.FormatAfterLastAttributeImmediate']); {$endif} if (heoFragmentOnly in Options) then AddData(''); end; procedure TSynExporterHTML.FormatAttributeInitImmediate( Attri: TLazCustomEditTextAttribute; IsSpace: Boolean); var Span, StyleStr: String; FG, BG: TColor; begin {$ifdef debug_synexporthtml} debugln(['TSynExporterHTML.FormatAttributeInitImmediate']); {$endif} FG := ValidatedColor(Attri.Foreground, fFont.Color); BG := ValidatedColor(Attri.Background, fBackgroundColor); if (not IsSpace and (FG <> fFont.Color)) or (UseBackGround and (BG <> fbackGroundColor)) then begin Span := MakeFontSpan(FG, BG); AddData(Span); end; if (Attri.Style <> []) then begin StyleStr := StyleToHtml(Attri.Style, IsSpace, True); AddData(StyleStr); end; end; procedure TSynExporterHTML.FormatAttributeDoneImmediate( Attri: TLazCustomEditTextAttribute; IsSpace: Boolean); var FG, BG: TColor; StyleStr: String; begin {$ifdef debug_synexporthtml} debugln(['TSynExporterHTML.FormatAttributeDoneImmediate']); {$endif} //reversed order compared to FormatAttributeInitImmediate if (Attri.Style <> []) then begin StyleStr := StyleToHtml(Attri.Style, IsSpace, False); AddData(StyleStr); end; FG := ValidatedColor(Attri.Foreground, fFont.Color); BG := ValidatedColor(Attri.Background, fBackgroundColor); if (not IsSpace and (FG <> fFont.Color)) or (UseBackGround and (BG <> fbackGroundColor)) then begin AddData(''); end; end; {end} //mh 2000-10-10 procedure TSynExporterHTML.FormatNewLine; begin AddNewLine; end; function TSynExporterHTML.GetFooter: string; begin Result := FontEnd + LineEnding + CodeEnd; if (heoWinClipHeader in Options) then Result := Result + EndFragmentComment; if not (heoFragmentOnly in Options) then begin if (Result <> '') then Result := Result + LineEnding; Result := Result + DocumentEnd; end; end; function TSynExporterHTML.GetFormatName: string; begin Result := SYNS_ExporterFormatHTML; end; function TSynExporterHTML.GetHeader: string; var sFontSize: string; //eb 2000-10-12 DocHeader, HeadText, WinClipHeader, SFooter: String; WinClipHeaderSize, FooterLen: Integer; begin Result := ''; DocHeader := ''; if not (heoFragmentOnly in Options) then begin if (heoDocType in fOptions) then DocHeader := DocHeader + DocType + LineEnding; HeadText := Generator; if (heoCharSet in fOptions) then HeadText := HeadText + LineEnding + CharSet; HeadText := HeadText + LineEnding + Format('%s',[Title]); DocHeader := DocHeader + Format(DocumentStart,[HeadText,ColorToHtml(fFont.Color),ColorToHTML(fBackgroundColor)]); if (heoWinClipHeader in fOptions) then DocHeader := DocHeader + LineEnding + StartFragmentComment; DocHeader := DocHeader + CodeStart; //Don't add LineEndings after this point, because of 
 tag
  end  //not heoFragmentOnly
  else
  begin
    if (heoWinClipHeader in fOptions) then
      DocHeader := DocHeader + StartFragmentComment + CodeStart
    else
      DocHeader := DocHeader + CodeStart;
  end;
  if fFontSize <> fsDefault then
    sFontSize := Format(' size=%d', [1 + Ord(fFontSize)])
  else
    sFontSize := '';
  DocHeader := DocHeader + Format(FontStart,[sFontSize, fFont.Name]);

  if (heoWinClipHeader in fOptions) then
  begin
    WinClipHeaderSize := Length(Format(WinClipHeaderFmt,[0,0,0,0]));
    SFooter := GetFooter;
    FooterLen := Length(SFooter);

    {$ifdef debug_synexporthtml}
    debugln(['TSynExporterHtml.GetHeader: WinClipHeaderSize=',WinClipHeadersize]);
    debugln(['  Footer="',Sfooter,'"']);
    debugln(['  FooterLen=',FooterLen]);
    debugln(['  BufferSize=',getBufferSize]);
    debugln(['  length(docHeader)=',length(docheader)]);
    {$endif}

    // Described in http://msdn.microsoft.com/library/sdkdoc/htmlclip/htmlclipboard.htm
    WinClipHeader := Format(WinClipHeaderFmt,
      [WinClipHeaderSize,  //HtmlStart
       WinClipHeaderSize + Length(DocHeader) + FooterLen + GetBufferSize - 1, //HtmlEnd
       WinClipHeaderSize + Utf8Pos(StartFragmentComment, DocHeader) + Length(StartfragmentComment) - 1, //StartFragment
       WinClipHeaderSize + Length(DocHeader) + Utf8Pos(EndFragmentComment, SFooter) + GetBufferSize - 1  //EndFragment
      ]);
      DocHeader := WinClipHeader + DocHeader;
  end;

  Result := DocHeader;
end;

procedure TSynExporterHTML.SetExportAsText(Value: boolean);
begin
  if (Value <> ExportAsText) then
  begin
    inherited SetExportAsText(Value);
    if Value then
      fOptions := fOptions - [heoWinClipHeader];
  end;
end;

procedure TSynExporterHTML.SetExportHtmlOptions(Value: TExportHtmlOptions);
begin
  if (fOptions <> Value) then
  begin
    Clear;
    fOptions := Value;
    if ExportAsText then fOptions := fOptions - [heoWinClipHeader];
    if (heoFragmentOnly in Value) then
    begin
      fOptions := fOptions - [heoDoctype, heoCharSet];
    end;
  end;
end;

function TSynExporterHTML.GetCreateHTMLFragment: Boolean;
begin
  Result := (heoFragmentOnly in fOptions);
end;

procedure TSynExporterHTML.SetCreateHTMLFragment(Value: Boolean);
begin
  if (GetCreateHTMLFragment <> Value) then
  begin
    if Value then
      Options := Options + [heoFragmentOnly]
    else
      Options := Options - [heoFragmentOnly];
  end;
end;

function TSynExporterHTML.MakeFontSpan(FG, BG: TColor): String;
begin
  Result := '';
end;

function TSynExporterHTML.StyleToHtml(AStyle: TFontStyles; IsSpace, DoSet: Boolean): String;
begin
  Result := '';
  if DoSet then
  begin
    if not IsSpace then
    begin
      if (fsBold in AStyle) then Result := Result + '';
      if (fsItalic in AStyle) then Result := Result + '';
      if (fsUnderline in AStyle) then Result := Result + '';
    end;
    //the only style that actually is applied to whitespace in HTML
    if (fsStrikeOut in AStyle) then Result := Result + '';
  end
  else
  begin //unset in the opposite order as set
    if (fsStrikeOut in AStyle) then Result := Result + '';
    if not IsSpace then
    begin
      if (fsUnderline in AStyle) then Result := Result + '';
      if (fsItalic in AStyle) then Result := Result + '';
      if (fsBold in AStyle) then Result := Result + '';
    end;
  end;
end;

end.