{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecExports;

interface

uses Windows, Classes, Graphics, {$IFDEF EC_DOTNET}Types, {$ENDIF}ecSyntMemo,
     ecSyntAnal, ecStrUtils;

type
  TExportType = (etCustom, etAllText, etSelection);

  TPlainTextSyntExport = class(TComponent)
  private
    FSyntMemo: TCustomSyntaxMemo;
    FExportType: TExportType;
    procedure SetSyntMemo(const Value: TCustomSyntaxMemo);
    procedure SaveBlockType;
    function GetExportData: ecString;
  protected
    FBuffer: TecStrings;
    FBlockType: BYTE;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ExpRange(AStart, ALength: integer);
    function GetStyleList(CurPos: integer; List: TStyleEntries): integer; virtual;
    procedure IntExport;

    function PickStyles(CurPos: integer): integer; virtual;
    procedure StartExport; virtual;
    procedure EndExport; virtual;
    procedure AddText(S: ecString); virtual;
    function GetSrcText(AStart, ALength: integer): ecString; virtual;
    procedure AddLineBreak; virtual;
    function GetHeader: string; virtual;
    function GetContent: ecString; virtual;
    function GetFooter: string; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExportAll;
    procedure ExportSelection;
    procedure ExportBlock(ABlock: TRect);
    procedure ExportRange(AStart, ALength: integer);
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const AFileName: string);
    procedure SaveToClipboard; virtual;
  published
    property SyntMemo: TCustomSyntaxMemo read FSyntMemo write SetSyntMemo;
    property ExportType: TExportType read FExportType write FExportType default etCustom;
    property ExportData: ecString read GetExportData;
  end;

  TBaseFormattedExport = class(TPlainTextSyntExport)
  private
    FCurStyles: TStyleEntries;
    FUseCaseFormatting: Boolean;
  protected
    procedure StartExport; override;
    function GetSrcText(AStart: Integer; ALength: Integer): ecString; override;
    function PickStyles(CurPos: Integer): Integer; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property UseCaseFormatting: Boolean read FUseCaseFormatting write FUseCaseFormatting default False;
  end;

  THTMLSyntExport = class(TBaseFormattedExport)
  private
    function GetStyleStr(Style: TSyntaxFormat): string;
    function GetStyleName(const StyleName: string): string;
    function FontStyle(style: TFontStyles): string;
    function FontWeight(style: TFontStyles): string;
    function HtmlColor(Color: TColor): string;
    function TextDecor(style: TFontStyles): string;
  protected
    procedure EndExport; override;
    procedure AddText(S: ecString); override;
    procedure AddLineBreak; override;
    function GetHeader: string; override;
    function GetFooter: string; override;
    function PickStyles(CurPos: integer): integer; override;
  public
    function GetStyleTable: string;
    function GetHtmlBody: ecString;
  end;

  TRTFSyntExport = class(TBaseFormattedExport)
  private
    FRTFBuffer: TStrings;
    FColorList: TList;
    FFontList: TStrings;
    FFont: TFont;
    FFontNew: TFont;
    FBgColor: TColor;
    function ReplaceReserved(const S: ecString): string;
    procedure SetNewStyle(AFont: TFont; ABgColor: TColor);
    procedure AddRTF(const S: string);
  protected
    procedure StartExport; override;
    procedure AddText(S: ecString); override;
    procedure AddLineBreak; override;
    function GetHeader: string; override;
    function GetContent: ecString; override;
    function GetFooter: string; override;
    function PickStyles(CurPos: integer): integer; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToClipboard; override;
  end;

implementation

uses SysUtils, ClipBrd, Contnrs;

{ TPlainTextSyntExport }

procedure TPlainTextSyntExport.ExportAll;
begin
  if not Assigned(FSyntMemo) then Exit;
  ExportRange(0, FSyntMemo.TextLength);
end;

procedure TPlainTextSyntExport.ExportSelection;
begin
  if not Assigned(FSyntMemo) then Exit;
  if FSyntMemo.SelectMode = msColumn then ExportBlock(FSyntMemo.SelRect)
     else ExportRange(FSyntMemo.SelStart, FSyntMemo.SelLength);
end;

procedure TPlainTextSyntExport.ExportRange(AStart, ALength: integer);
begin
  if not Assigned(FSyntMemo) then Exit;
  FBlockType := TEXT_BLOCK_LINEAR;
  StartExport;
  ExpRange(AStart, ALength);
  EndExport;
end;

procedure TPlainTextSyntExport.ExportBlock(ABlock: TRect);
var i, sLeft, sRight, sp, cnt: integer;
begin
  if not Assigned(FSyntMemo) then Exit;
  FBlockType := TEXT_BLOCK_RECTANGLE;
  StartExport;
  for i := ABlock.Top to ABlock.Bottom do
    begin
     sLeft := FSyntMemo.LogToLinesPos(Point(ABlock.Left, i)).X;
     sRight := FSyntMemo.LogToLinesPos(Point(ABlock.Right, i)).X;
     with FSyntMemo.Lines do
      if LineLength(i) > sLeft then
       begin
        cnt := LineLength(i);
        if sRight < cnt then cnt := sRight;
        sp := LineIndex(i) - 1 + sLeft;
        ExpRange(sp, cnt - sLeft);
       end;
     AddLineBreak;
    end;
  EndExport;
end;

function TPlainTextSyntExport.GetSrcText(AStart,
  ALength: integer): ecString;
begin
  Result := FSyntMemo.Lines.SubString(AStart + 1, ALength);
end;

procedure TPlainTextSyntExport.ExpRange(AStart, ALength: integer);
var i, {n,} AEnd, ANext: integer;
//    S: ecString;
    p1, p2: TPoint;
begin
  AEnd := AStart + ALength;
  if Assigned(FSyntMemo.SyntObj) then
    FSyntMemo.SyntObj.AppendToPos(AEnd);
  while AStart < AEnd do
   begin
     ANext := PickStyles(AStart);
     if ANext > AEnd then ANext := AEnd;
     if ANext <= AStart then Break;
     p1 := FSyntMemo.StrPosToCaretPos(AStart);
     p2 := FSyntMemo.StrPosToCaretPos(ANext);
     if p2.Y = p1.Y then
      AddText(GetSrcText(AStart, ANext - AStart))
     else
      begin
        AddText(GetSrcText(AStart, FSyntMemo.Lines.LineLength(p1.Y) - p1.X));
        AddLineBreak;
        for i := p1.Y + 1 to p2.Y - 1 do
         begin
          AddText(GetSrcText(FSyntMemo.Lines.LineIndex(i) - 1, FSyntMemo.Lines.LineLength(i)));
          AddLineBreak;
         end;
        AddText(GetSrcText(FSyntMemo.Lines.LineIndex(p2.Y) - 1, p2.X));
      end;
{     S := FSyntMemo.Lines.SubString(AStart + 1, ANext - AStart);
     i := 1;
     while i <= Length(S) do
      begin
       if S[i] = #10 then
        begin
          n := i - 1;
          if (i > 1) and (S[i - 1] = #13) then Dec(n);
          if n > 0 then AddText(Copy(S, 1, n));
          AddLineBreak;
          Delete(S, 1, i);
          i := 1;
        end else Inc(i);
      end;
     if S <> '' then AddText(S);}
     AStart := ANext;
   end;
end;

procedure TPlainTextSyntExport.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSyntMemo) then
   FSyntMemo := nil;
end;

function TPlainTextSyntExport.PickStyles(CurPos: integer): integer;
begin
  Result := FSyntMemo.TextLength;
end;

procedure TPlainTextSyntExport.SaveToClipboard;
var cs: TFontCharset;
begin
  IntExport;
  if FSyntMemo <> nil then
    cs := FSyntMemo.Charset
  else
    cs := DEFAULT_CHARSET;
  Clipboard.Open;
  try
    SetClipboardText(ExportData, cs); //GetHeader + GetContent + GetFooter);
    SaveBlockType;
  finally
    Clipboard.Close;
  end;
end;

procedure TPlainTextSyntExport.SaveBlockType;
begin
  SetClipboardBlockType(FBlockType);
end;

procedure TPlainTextSyntExport.SaveToFile(const AFileName: string);
var Stream: TFileStream;
begin
  Stream := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPlainTextSyntExport.SaveToStream(Stream: TStream);
var S: string;
begin
  IntExport;
  S := GetHeader + GetContent + GetFooter;
  if Length(S) > 0 then
    Stream.Write(S[1], Length(S));
end;

procedure TPlainTextSyntExport.SetSyntMemo(const Value: TCustomSyntaxMemo);
begin
  if FSyntMemo <> Value then
   begin
    FSyntMemo := Value;
    if Assigned(FSyntMemo) then
     FSyntMemo.FreeNotification(Self);
   end;
end;

procedure TPlainTextSyntExport.AddLineBreak;
begin
  FBuffer.Add('');
end;

procedure TPlainTextSyntExport.AddText(S: ecString);
begin
  if FBuffer.Count = 0 then FBuffer.Add(S)
   else FBuffer[FBuffer.Count - 1] := FBuffer[FBuffer.Count - 1] + S;
end;

function TPlainTextSyntExport.GetContent: ecString;
begin
  Result := FBuffer.Text;
  if Length(Result) > 1 then
    Result := Copy(Result, 1, Length(Result) - Length(sLineBreak));
end;

function TPlainTextSyntExport.GetFooter: String;
begin
  Result := '';
end;

function TPlainTextSyntExport.GetHeader: string;
begin
  Result := '';
end;

function TPlainTextSyntExport.GetStyleList(CurPos: integer; List: TStyleEntries): integer;
begin
  if Assigned(FSyntMemo) then
    Result := FSyntMemo.GetStyleList(CurPos, List, slExported, False)
  else
    Result := FSyntMemo.TextLength;
end;

procedure TPlainTextSyntExport.EndExport;
begin

end;

procedure TPlainTextSyntExport.StartExport;
begin
  FBuffer.Clear;
end;

procedure TPlainTextSyntExport.IntExport;
begin
  case FExportType of
    etAllText:  ExportAll;
    etSelection: ExportSelection;
  end;
end;

constructor TPlainTextSyntExport.Create(AOwner: TComponent);
begin
  inherited;
  FBuffer := TecStringList.Create;
end;

destructor TPlainTextSyntExport.Destroy;
begin
  FBuffer.Free;
  inherited;
end;

function TPlainTextSyntExport.GetExportData: ecString;
begin
  Result := GetHeader + GetContent + GetFooter;
end;

{ TBaseFormattedExport }

constructor TBaseFormattedExport.Create(AOwner: TComponent);
begin
  inherited;
  FCurStyles := TStyleEntries.Create;
end;

destructor TBaseFormattedExport.Destroy;
begin
  FreeAndNil(FCurStyles);
  inherited;
end;

function TBaseFormattedExport.GetSrcText(AStart,
  ALength: Integer): ecString;
begin
  Result := inherited GetSrcText(AStart, ALength);
  if FUseCaseFormatting or (soUseCaseFormat in SyntMemo.OptionsEx) then
    begin
      ChangeStrCase(Result, TChangeCase(FSyntMemo.CharCase));
      Change_Case(Result, AStart, FCurStyles);
    end;
end;

function TBaseFormattedExport.PickStyles(CurPos: Integer): Integer;
begin
  FCurStyles.Clear;
  Result := GetStyleList(CurPos, FCurStyles);
end;

procedure TBaseFormattedExport.StartExport;
begin
  inherited;
  FCurStyles.Clear;
end;

{ THTMLSyntExport }

procedure THTMLSyntExport.AddLineBreak;
begin
  inherited AddText('<br>');
  inherited AddLineBreak;
end;

procedure THTMLSyntExport.AddText(S: ecString);
var ps: integer;
   {$IFDEF EC_UNICODE}
    C: WORD;
   {$ENDIF}
begin
  for ps := Length(S) downto 1 do
   {$IFDEF EC_UNICODE}
   if Ord(S[ps]) > $FF then
    begin
      C := Ord(S[ps]);
      Delete(S, ps, 1);
      Insert(Format('&#%d;', [C]), S, ps);
    end else
   {$ENDIF}
   if (ps > 1) and (S[ps] = #32) and (S[ps - 1] = #32) then
    begin
      Delete(S, ps, 1);
      Insert('&nbsp;', S, ps);
    end else
   if S[ps] = '<' then
    begin
      Delete(S, ps, 1);
      Insert('&lt;', S, ps);
    end else
   if S[ps] = '>' then
    begin
      Delete(S, ps, 1);
      Insert('&gt;', S, ps);
    end;
  inherited AddText(S);
end;

function THTMLSyntExport.GetFooter: string;
begin
  Result := '</body></html>';
end;

function THTMLSyntExport.GetHeader: string;
begin
  Result := '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">' + sLineBreak +
    '<html><head>' + GetStyleTable  + '</head>' + sLineBreak +
    '<body id="seDefault">';
end;

function THTMLSyntExport.GetStyleTable: string;
var i: integer;
    st: TStringList;
begin
  st := TStringList.Create;
  try
    st.Add('<STYLE TYPE="text/css" TITLE="Bright Colours">');
    // Create styles
    if (FSyntMemo.SyntObj = nil) or (FSyntMemo.SyntObj.Owner.DefStyle = nil) then
     with FSyntMemo.Font do
       st.Add(Format('#seDefault {color: %s; font-family: "%s"; text-decoration: %s;'+
                     'font-weight: %s; font-style: %s; background-color: %s; font: %dpt;}',
        [HtmlColor(Color), Name, TextDecor(Style), FontWeight(Style), FontStyle(Style), HtmlColor(FSyntMemo.Color), Size]))
    else
     with FSyntMemo.SyntObj.Owner do
       st.Add(Format('#seDefault {%s}', [GetStyleStr(FSyntMemo.SyntObj.Owner.DefStyle)]));

    if Assigned(FSyntMemo.SyntObj) then
     with FSyntMemo.SyntObj.Owner do
      for i := 0 to Formats.Count - 1 do
       st.Add(Format('#%s {%s}', [GetStyleName(Formats[i].DisplayName), GetStyleStr(Formats[i])]));
    st.Add('</STYLE>');
    Result := st.Text;
  finally
    st.Free;
  end;
end;

function THTMLSyntExport.GetStyleName(const StyleName: string): string;
var i: integer;
begin
  Result := StyleName;
  for i := 1 to Length(Result) do
   if not IsLetterA(Result[i]) and not IsDigitA(Result[i]) then
    Result[i] := '_';
end;

function THTMLSyntExport.TextDecor(style: TFontStyles): string;
begin
  if fsUnderline in style then Result := 'underline' else
   if fsStrikeOut in style then Result := 'line-through' else
    Result := 'none';
end;

function THTMLSyntExport.FontWeight(style: TFontStyles): string;
begin
  if fsBold in style then Result := 'bold' else Result := 'normal';
end;

function THTMLSyntExport.FontStyle(style: TFontStyles): string;
begin
  if fsItalic in style then Result := 'italic' else Result := 'normal';
end;

function THTMLSyntExport.HtmlColor(Color: TColor): string;
begin
  Color := ColorToRGB(Color);
  Result := '#' + IntToHex(Color and $FF, 2) + IntToHex((Color shr 8) and $FF, 2) + IntToHex((Color shr 16) and $FF, 2);
end;

function THTMLSyntExport.GetStyleStr(Style: TSyntaxFormat): string;
begin
  Result := '';
  if Style.BgColor <> clNone then
   Result := 'background-color: ' + HtmlColor(Style.BgColor) + ';';
  if Style.FormatType <> ftBackground then
   begin
    if Style.Font.Color <> clNone then
     Result := Result + ' color: ' + HtmlColor(Style.Font.Color) + ';';
    if Style.FormatType <> ftColor then
     begin
      Result := Result + ' font-weight: ' + FontWeight(Style.Font.Style) + ';';
      Result := Result + ' font-style: ' + FontStyle(Style.Font.Style) + ';';
      Result := Result + ' text-decoration: ' + TextDecor(Style.Font.Style) + ';';
      if Style.FormatType = ftCustomFont then
       begin
         Result := Result + ' font: ' + IntToStr(Style.Font.Size) + 'pt;';
         Result := Result + ' font-family: "' + Style.Font.Name + '";';
       end;
     end;
   end;
end;

function THTMLSyntExport.PickStyles(CurPos: integer): integer;
var i: integer;
begin
  for i := 0 to FCurStyles.Count - 1 do
   inherited AddText('</span>');
  Result := inherited PickStyles(CurPos);
  for i := 0 to FCurStyles.Count - 1 do
   inherited AddText(Format('<SPAN id="%s">', [GetStyleName(FCurStyles[i].Style.DisplayName)]));
end;

procedure THTMLSyntExport.EndExport;
var i: integer;
begin
  inherited;
  for i := 0 to FCurStyles.Count - 1 do
   inherited AddText('</span>');
  FCurStyles.Clear;
end;

function THTMLSyntExport.GetHtmlBody: ecString;
begin
  Result := GetContent;
end;

{ TRTFSyntExport }

constructor TRTFSyntExport.Create(AOwner: TComponent);
begin
  inherited;
  FFontList := TStringList.Create;
  FColorList := TList.Create;
  FFont := TFont.Create;
  FFontNew := TFont.Create;
  FRTFBuffer := TStringList.Create;
end;

destructor TRTFSyntExport.Destroy;
begin
  FFontList.Free;
  FColorList.Free;
  FFont.Free;
  FFontNew.Free;
  FRTFBuffer.Free;
  inherited;
end;

function TRTFSyntExport.ReplaceReserved(const S: ecString): string;
var i: integer;
    S2: string;
begin
  Result := '';
  SetLength(S2, 2);
  for i := 1 to Length(S) do
   {$IFDEF EC_UNICODE}
   if Ord(S[i]) > $FF then
    Result := Result + Format('\u%d  ', [Ord(S[i])])
   else
   {$ENDIF}
     case S[i] of
       #9: Result := Result + '\tab ';
       '\', '{', '}':
        begin
         Result := Result + '\';
         Result := Result + S[i];
        end;
       else Result := Result + S[i];
     end;
end;

procedure TRTFSyntExport.AddRTF(const S: string);
begin
  if FRTFBuffer.Count = 0 then FRTFBuffer.Text := S
   else FRTFBuffer[FRTFBuffer.Count - 1] := FRTFBuffer[FRTFBuffer.Count - 1] + S;
end;

procedure TRTFSyntExport.AddLineBreak;
begin
  inherited;
  FRTFBuffer.Add('\par ');
end;

procedure TRTFSyntExport.AddText(S: ecString);
begin
  inherited;
  AddRTF(ReplaceReserved(S));
end;

procedure TRTFSyntExport.SetNewStyle(AFont: TFont; ABgColor: TColor);
var FChanged: Boolean;
    b1, b2: Boolean;
    FontStyle: TFontStyle;
const
  FontTags: array[TFontStyle] of string = ('\b', '\i', '\ul', '\strike');

  function GetColorIndex(Color: TColor): integer;
  begin
    Color := ColorToRGB(Color);
    Result := FColorList.IndexOf(TObject(Color));
    if Result = -1 then
      Result := FColorList.Add(TObject(Color));
  end;
  function GetFontIndex(const FontName: string): integer;
  begin
    Result := FFontList.IndexOf(FontName);
    if Result = -1 then
      Result := FFontList.Add(FontName);
  end;
  procedure AddCmd(const S: string);
  begin
   AddRTF(S);
   FChanged := True;
  end;
begin
  FChanged := False;
  if FBgColor <> ABgColor then
   AddCmd(Format('\highlight%d', [GetColorIndex(ABgColor)]));
  if FFont.Color <> AFont.Color then
   AddCmd(Format('\cf%d', [GetColorIndex(AFont.Color)]));
  if FFont.Name <> AFont.Name then
   AddCmd(Format('\f%d', [GetFontIndex(AFont.Name)]));
  if FFont.Size <> AFont.Size then
   AddCmd(Format('\fs%d', [AFont.Size*2]));

  for FontStyle := Low(TFontStyle) to High(TFontStyle) do
   begin
    b1 := FontStyle in FFont.Style;
    b2 := FontStyle in AFont.Style;
    if b1 <> b2 then
     begin
      AddCmd(FontTags[FontStyle]);
      if not b2 then AddCmd('0');
     end;
   end;

  if FChanged then AddRTF(' ');
  FFont.Assign(AFont);
  FBgColor := ABgColor;
end;

procedure TRTFSyntExport.StartExport;
begin
  inherited;
  FRTFBuffer.Clear;
  FFontList.Clear;
  FColorList.Clear;

  FFont.Style := [];
  FFont.Color := clBlack;
  FFont.Size := 0;
  FBgColor := clWhite;
{  if FSyntMemo.SyntObj <> nil then
   with FSyntMemo.SyntObj.Owner.DefaultStyle do
    SetNewStyle(Font, BgColor)
  else}
  with FSyntMemo do
   SetNewStyle(Font, Color);
  if FFontList.Count = 0 then
   FFontList.Add(FFont.Name);
end;

function TRTFSyntExport.GetHeader: string;
var i: integer;
  function ColorToRTF(C: TColor): string;
  begin
    Result := Format('\red%d\green%d\blue%d;',
      [GetRValue(C), GetGValue(C), GetBValue(C)]);
  end;
begin
  Result := '{\rtf1\ansi\deff0\deftab720{\fonttbl';
  // font list
  for i := 0 to FFontList.Count - 1 do
   Result := Result + Format('{\f%d\fmodern %s;}', [i, FFontList[i]]);
  // color list
  Result := Result + '}'#13#10'{\colortbl';
  for i := 0 to FColorList.Count - 1 do
    Result := Result + ColorToRTF(TColor(FColorList[i]));
  Result := Result + '}'#13#10;

  Result := Result + '\deflang1033\pard\plain';
end;

function TRTFSyntExport.GetContent: ecString;
begin
  Result := FRTFBuffer.Text;
end;

function TRTFSyntExport.PickStyles(CurPos: integer): integer;
var i: integer;
    FBack: TColor;
  procedure ApplyStyle(Style: TSyntaxFormat);
  begin
    if (Style = nil) or not Style.Enabled then Exit;
    if Style.BgColor <> clNone then
      FBack := Style.BgColor;
    case Style.FormatType of
     ftCustomFont, ftFontAttr:
       FFontNew.Assign(Style.Font);
     ftColor: if Style.Font.Color <> clNone then
                FFontNew.Color := Style.Font.Color;
    end;
  end;
begin
  // Default
  with FSyntMemo do
    begin
     FFontNew.Assign(Font);
     FBack := Color;
    end;
  if (FSyntMemo.SyntObj <> nil) and (FSyntMemo.SyntObj.Owner.DefStyle <> nil) then
   with FSyntMemo.SyntObj.Owner.DefStyle do
    ApplyStyle(FSyntMemo.SyntObj.Owner.DefStyle);

  Result := inherited PickStyles(CurPos);
  for i := 0 to FCurStyles.Count - 1 do
    ApplyStyle(TStyleEntry(FCurStyles[i]).Style);
  SetNewStyle(FFontNew, FBack);
end;

function TRTFSyntExport.GetFooter: string;
begin
  Result := '}';
end;

procedure TRTFSyntExport.SaveToClipboard;
var cs: TFontCharset;
    Buf: {$IFDEF EC_DOTNET}TBytes{$ELSE}string{$ENDIF};
begin
  IntExport;
  if FSyntMemo <> nil then cs := FSyntMemo.Charset
                      else cs := DEFAULT_CHARSET;
  Clipboard.Open;
  try
    SetClipboardText(inherited GetContent, cs);
    SaveBlockType;
    {$IFDEF EC_DOTNET}
    Buf := TBytes(AnsiString(ExportData));//GetHeader + GetContent + GetFooter));
    {$ELSE}
    Buf := GetHeader + GetContent + GetFooter;
    {$ENDIF}
    SetClipboardFromBuffer(CF_RTF, Buf{$IFNDEF EC_DOTNET}[1]{$ENDIF}, Length(Buf));
  finally
    Clipboard.Close;
  end;
end;

end.

