{***************************************************************************}
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2013                                               }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}
unit FMX.TMSGridRTF;

interface

{$I TMSDEFS.INC}

uses
  SysUtils, Classes, FMX.TMSRTFEngine, FMX.TMSGrid, FMX.TMSGridData, FMX.TMSGridCell,
  UITypes, Types, FMX.Types, FMX.Dialogs, FMX.TMSXUtil, FMX.TMSBaseControl
  , UIConsts, FMX.Styles
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  ;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 5; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

  // version history
  // v1.0.0.0 : First release
  // v1.1.0.0 : New: Capability to export multiple grids to a single RTF file
  // v1.5.0.0 : New : support for XE4

type

  TFMXGridRTFIOProgressEvent = procedure(Sender: TObject; RowNum, RowTot: integer) of object;
  TFMXGridRTFIOPageBreak = procedure(Sender: TObject; ARow: Integer; var DoPageBreak: boolean) of object;

  TOverwriteMode = (omNever, omAlways, omWarn);
  TExportMode = (emFile, emStream, emString, emBuffer);

  TTMSFMXGridRTFIOOptions = class(TPersistent)
  private
    FExportCellProperties: Boolean;
    FExportHiddenColumns: Boolean;
    FExportOverwriteMessage: string;
    FExportOverwrite: TOverwriteMode;
    FConvertHTML: Boolean;
    FExportShowInWord: Boolean;
    FExportBackGround: Boolean;
    FExportMsWordFeatures: Boolean;
    FExportImages: Boolean;
    FExportRTFCell: Boolean;
    FExportSelectedCells: Boolean;
    FTitle: string;
    FFooter: string;
    FExportBorders: Boolean;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property ExportBackGround: Boolean read FExportBackGround write FExportBackGround default false;
    property ExportOverwrite: TOverwriteMode read FExportOverwrite write FExportOverwrite default omNever;
    property ExportOverwriteMessage: string read FExportOverwriteMessage write FExportOverwriteMessage;
    property ExportCellProperties: Boolean read FExportCellProperties write FExportCellProperties default True;
    property ExportHiddenColumns: Boolean read FExportHiddenColumns write FExportHiddenColumns default False;
    property ExportShowInWord: Boolean read FExportShowInWord write FExportShowInWord;
    property ExportMsWordFeatures: Boolean read FExportMsWordFeatures write FExportMsWordFeatures;
    property ExportImages: Boolean read FExportImages write FExportImages;
    property ConvertHTML: Boolean read FConvertHTML write FConvertHTML;
    property ExportSelectedCells: Boolean read FExportSelectedCells write FExportSelectedCells default false;
    property ExportBorders: Boolean read FExportBorders write FExportBorders default True;
    property Title: string read FTitle write FTitle;
    property Footer: string read FFooter write FFooter;
  end;

  TProGrid = class(TTMSFMXGrid)
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXGridRTFIO = class(TComponent)
  private
    FGrid: TTMSFMXGrid;
    FOptions : TTMSFMXGridRTFIOOptions;
    FOnProgress: TFMXGridRTFIOProgressEvent;
    FGridStartRow: integer;
    FGridStartCol: integer;
    FOnPageBreak: TFMXGridRTFIOPageBreak;
    FBuffer: string;
    FFontBuffer: string;
    FColorBuffer: string;
    procedure SetGrid(const Value: TTMSFMXGrid);
    function CurrentGrid: TProGrid;
    procedure SetOptions(const Value: TTMSFMXGridRTFIOOptions);
    procedure SetGridStartCol(const Value: integer);
    procedure SetGridStartRow(const Value: integer);
    procedure ExportInternal(FileName: String; st: TStream; var S: String; ExportMode: TExportMode);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ExportRTF(Const FileName: TFileName);
    function ExportToString: string;
    procedure ExportToStream(st: TStream);
    procedure ExportToBuffer;
    procedure AppendToBuffer;
    procedure ExportBufferToRTF(const FileName: TFileName);
  published
    property Grid: TTMSFMXGrid read FGrid write SetGrid;
    //property AutoResizeGrid: Boolean read FAutoResizeGrid write FAutoResizeGrid default true;
    property GridStartRow: integer read FGridStartRow write SetGridStartRow default 1;
    property GridStartCol: integer read FGridStartCol write SetGridStartCol default 1;
    property Options: TTMSFMXGridRTFIOOptions read FOptions write SetOptions;
    //Events
    property OnProgress: TFMXGridRTFIOProgressEvent read FOnProgress write FOnProgress;
    property OnPageBreak: TFMXGridRTFIOPageBreak read FOnPageBreak write FOnPageBreak;
  end;

implementation

{$IFNDEF WIN32}
{$IFNDEF WIN64}
uses
  Posix.UniStd;
{$ENDIF}
{$ENDIF}

{$R *.RES}

//------------------------------------------------------------------------------

function IsHyperLink(Text: String): Boolean;
begin
  Result := (pos('http://', Text) > 0) or (pos('file://', Text) > 0) or (pos('ftp://', Text) > 0)
             or (pos('nntp://', Text) > 0) or (pos('https://', Text) > 0) or (pos('mailto:', Text) > 0);
end;

//------------------------------------------------------------------------------

{ TASGRTFIOOptions }

procedure TTMSFMXGridRTFIOOptions.Assign(Source: TPersistent);
begin
  if Source is TTMSFMXGridRTFIOOptions then
  begin
    FExportCellProperties := (Source as TTMSFMXGridRTFIOOptions).FExportCellProperties;
    FExportHiddenColumns := (Source as TTMSFMXGridRTFIOOptions).FExportHiddenColumns;
    FExportOverwrite := (Source as TTMSFMXGridRTFIOOptions).FExportOverwrite;
    FExportOverwriteMessage := (Source as TTMSFMXGridRTFIOOptions).FExportOverwriteMessage;
    FExportSelectedCells := (Source as TTMSFMXGridRTFIOOptions).FExportSelectedCells;
    FExportBackGround := (Source as TTMSFMXGridRTFIOOptions).FExportBackGround;
    FExportShowInWord:= (Source as TTMSFMXGridRTFIOOptions).FExportShowInWord;
    FExportMsWordFeatures := (Source as TTMSFMXGridRTFIOOptions).FExportMsWordFeatures;
    FConvertHTML := (Source as TTMSFMXGridRTFIOOptions).FConvertHTML;
    FExportBorders := (Source as TTMSFMXGridRTFIOOptions).ExportBorders;
    FTitle := (Source as TTMSFMXGridRTFIOOptions).FTitle;
    FFooter := (Source as TTMSFMXGridRTFIOOptions).FFooter;
  end;
end;

//------------------------------------------------------------------------------

constructor TTMSFMXGridRTFIOOptions.Create;
begin
  inherited Create;
  FExportCellProperties := True;
  FExportHiddenColumns := False;
  FExportOverwrite := omNever;
  FExportOverwriteMessage := 'File already exists'#13'Ok to overwrite ?';
  FConvertHTML := True;
  FExportBackGround := False;
  FExportMsWordFeatures := True;
  FExportImages := False;
  FExportRTFCell := True;
  FExportBorders := True;
  FTitle := '';
  FFooter := '';
end;

//------------------------------------------------------------------------------

{ TTMSFMXGridRTFIO }

procedure TTMSFMXGridRTFIO.AppendToBuffer;
var
  S: string;
begin
  S := '';
  ExportInternal('', nil, S, emBuffer);
  FBuffer := FBuffer + S;
end;

//------------------------------------------------------------------------------

constructor TTMSFMXGridRTFIO.Create(AOwner: TComponent);
begin
  inherited;
  //FAutoResizeGrid := true;
  FGridStartCol := 1;
  FGridStartRow := 1;
  FOptions := TTMSFMXGridRTFIOOptions.Create;
end;

//------------------------------------------------------------------------------

function TTMSFMXGridRTFIO.CurrentGrid: TProGrid;
begin
  Result := TProGrid(FGrid);
end;

//------------------------------------------------------------------------------

destructor TTMSFMXGridRTFIO.Destroy;
begin
  FOptions.Free;
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
  begin
    if AComponent = FGrid then
      FGrid := nil;
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.SetGridStartCol(const Value: integer);
begin
  if Value >= 0 then FGridStartCol := Value else FGridStartCol := 1;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.SetGridStartRow(const Value: integer);
begin
  if Value >= 0 then
    FGridStartRow := Value
  else
    FGridStartRow := 1;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.SetGrid(const Value: TTMSFMXGrid);
begin
  FGrid := Value;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.SetOptions(const Value: TTMSFMXGridRTFIOOptions);
begin
  FOptions.Assign(Value);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.ExportRTF(const FileName: TFileName);
var
  S: string;
begin
  S := '';
  ExportInternal(FileName, nil, S, emFile);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.ExportBufferToRTF(const FileName: TFileName);
var
  rtf: string;
  f: TextFile;
begin
  rtf := '{'+ RTFHeader + FFontBuffer + FColorBuffer +
            '\viewkind4\uc1'  + FBuffer + '\par}';;

  AssignFile(f, FileName);
  {$i-}
  Rewrite(f);
  {$i+}
  if IOResult <> 0 then
    raise Exception.Create('Cannot Create ' + FileName);

  Writeln(f, rtf);
  CloseFile(f);
end;

procedure TTMSFMXGridRTFIO.ExportInternal(FileName: String; st: TStream;
  var S: String; ExportMode: TExportMode);
var
  rg, cg: integer;
  cp: TCellProperty;
  HiddenCount: Integer;
  CReal, i: Integer;
  CellData: String;
  MergeColWidth, cs: Integer;
  MergedCol: Boolean;
  RTFEngine: TRTFEngine;
  DoPageBreak: Boolean;
  skipCell: Boolean;
  scol,ecol: integer;
  AFont: TFont;
  l: TTMSFMXGridCellLayout;
  cellclasstype,prevclasstype: TFmxObjectClass;
  cell: TFMXObject;
  picname: string;

  function RowHasMergedCells(ARow: integer): boolean;
  var
    i: integer;
  begin
    Result := false;
    for i := scol to ecol do
      if CurrentGrid.IsMerged(i, ARow) then
      begin
        if not CurrentGrid.IsYMergedCell(i, ARow) and CurrentGrid.IsXMergedCell(i, ARow) then   // FF: Row merge iss
        begin
          Result := true;
          Break;
        end;
      end;
  end;

  function CellWidth(Col, Row: integer; var CellSpan: Integer): integer;
  var
    pt: TPoint;
    i: integer;
  begin
    Result := Round(CurrentGrid.ColumnWidths[col]);
    pt := CurrentGrid.CellSpan(col,row);
    CellSpan := pt.X;
    if pt.x >= 1 then
      for i := 1 to pt.X -1 do
      begin
        Result := Result + Round(CurrentGrid.ColumnWidths[col + i]) { + CurrentGrid.gridlinewidth};
      end;
  end;

  (*
  procedure AddCellGraphics(CellGraphic: TCellGraphic);
  var
    APic: TPicture;
    bmp: TBitMap;
    idx: Integer;
  begin
    if CellGraphic <> nil then
    begin
      if ((CellGraphic.CellHAlign = haAfterText) or (CellGraphic.CellVAlign = vaUnderText)) and not CellDataAdded then
        Exit;

      if ImageAdded then
        Exit;

      APic := TPicture.Create;
      case CellGraphic.CellType of
        ctBitmap:
        begin
          APic.Bitmap := CellGraphic.CellBitmap;
          RTFEngine.AddPicture(APic);
          ImageAdded := True;
        end;
        ctIcon:
        begin
          APic.Graphic := CellGraphic.CellIcon;
          RTFEngine.AddPicture(APic);
          ImageAdded := True;
        end;
        ctImageList:
        begin
          if Assigned(CurrentGrid.GridImages) then
          begin
            bmp := TBitMap.Create;
            bmp.Height := CurrentGrid.GridImages.Height;
            bmp.Width := CurrentGrid.GridImages.Width;
            CurrentGrid.GridImages.Draw(bmp.Canvas, 0, 0, CellGraphic.CellIndex);
            APic.Bitmap := bmp;
            RTFEngine.AddPicture(APic);
            bmp.Free;
            ImageAdded := True;
          end;
        end;
        ctImages:
        begin
          if Assigned(CurrentGrid.GridImages) then
          begin
            ImageAdded := True;
            for idx := 1 to TIntList(CellGraphic.CellBitmap).Count do
            begin
               bmp := TBitMap.Create;
               bmp.Height := CurrentGrid.GridImages.Height;
               bmp.Width := CurrentGrid.GridImages.Width;
               CurrentGrid.GridImages.Draw(bmp.Canvas, 0, 0,TIntList(CellGraphic.CellBitmap).Items[idx-1]);
               APic.Bitmap := bmp;
               RTFEngine.AddPicture(APic);
               if not CellGraphic.CellBoolean then
                 RTFEngine.AddNewLine;
               bmp.Free;
            end;
          end;
        end;
        ctPicture:
        begin

        end;
      end;
      APic.Free;
    end;
  end;
  *)

begin
  if CurrentGrid = nil then
    raise Exception.Create('There is no TMSFMXGrid assigned to the component');

  case ExportMode of
    emFile:   if (FileName = '') then raise Exception.Create('Invalid File Name');
    emStream: if not Assigned(st) then raise Exception.Create('Invalid Stream');
  end;

  cell := nil;
  cellclasstype := nil;
  prevclasstype := nil;

  l := TTMSFMXGridCellLayout.Create(nil);

  if ExportMode = emFile then
  begin
    case Options.ExportOverwrite of
    omAlways:
      begin
        if FileExists(FileName) then
          DeleteFile(FileName);
      end;
    omWarn:
      begin
        if FileExists(FileName) then
        begin
          if MessageDlg(Format(Options.ExportOverwriteMessage,[FileName]),TMsgDlgType.mtCOnfirmation,[TMsgDlgBtn.mbYes,TMsgDlgBtn.mbNo],0) = mrYes then
            DeleteFile(FileName)
          else
            Exit;
        end;
      end;
    omNever:
      if FileExists(FileName) then
        Exit;
    end;
  end;

  RTFEngine := TRTFEngine.Create;

  //RTFEngine.Images := CurrentGrid.GridImages;

 {
  if Options.ExportCellSizes then
  begin
    for rg := GridStartRow to CurrentGrid.RowCount - 1 do
    begin
      rx := rg - GridStartRow + XlsStartRow;
      Workbook.RowHeight[rx] := Round(CurrentGrid.RowHeights[rg] * RowMult / Zoom100) - CellOfs;
    end;

    for cg := GridStartCol to CurrentGrid.ColCount - 1 do
    begin
      cx := cg - GridStartCol + XlsStartCol;
      Workbook.ColumnWidth[cx] := Round(CurrentGrid.ColWidths[cg] * ColMult / Zoom100) - CellOfs;
    end;
  end;
  }

  RTFEngine.AddFont(CurrentGrid.GetDefaultFont(CurrentGrid.FixedColumns,CurrentGrid.FixedRows));
  RTFEngine.AddForeColor(claBlack);

  RTFEngine.AddNewLine; // Extra new line added to avoid msword issue
  if (Options.Title <> '') then
  begin
    {$IFDEF DELPHIXE6_LVL}
    RTFEngine.AddHAlignment(TTextAlign.Center);  // Since table is Center Aligned
    {$ELSE}
    RTFEngine.AddHAlignment(TTextAlign.taCenter);  // Since table is Center Aligned
    {$ENDIF}
    RTFEngine.AddText(Options.Title);
    RTFEngine.AddNewLine;
  end;

  RTFEngine.StartTable(taCenter);

  scol := GridStartCol;
  ecol := CurrentGrid.ColumnCount - 1;

  if Options.ExportSelectedCells then
  begin
    scol := CurrentGrid.Selection.StartCol;
    ecol := CurrentGrid.Selection.EndCol;
  end;


  if RowHasMergedCells(GridStartRow) then
  begin
    i := GridStartCol;
    MergedCol := True;
    while i <= CurrentGrid.ColumnCount-1 do
    begin
      MergeColWidth := cellwidth(i, GridStartRow, cs);
      RTFEngine.AddColumn(MergeColWidth*14);
      i := i + cs + 1;
    end;
  end
  else
  begin
    MergedCol := False;
    for i := scol to ecol do
      RTFEngine.AddColumn(Round(CurrentGrid.ColumnWidths[i]*14));
  end;

  CurrentGrid.ExportNotification(esExportStart,-1);

  HiddenCount := CurrentGrid.HiddenColumnCount;

  if Options.ExportHiddenColumns and not Options.ExportSelectedCells then
    CurrentGrid.ColumnCount := CurrentGrid.ColumnCount + HiddenCount;

  //Export data
  for rg := GridStartRow to CurrentGrid.RowCount - 1 do
  begin
    if (rg > GridStartRow) then
    begin
      if RowHasMergedCells(rg) then
      begin
        i := scol;
        MergedCol := True;
        RTFEngine.ReDefColWidth;
        while i <= ecol do
        begin
          MergeColWidth := CellWidth(i, rg, cs);
          RTFEngine.AddColumn(MergeColWidth * 14);
          if cs > 1 then
            cs := cs - 1;
          i := i + cs + 1;
        end;
      end
      else
      begin
        if MergedCol then
        begin
          MergedCol := False;
          RTFEngine.ReDefColWidth;

          for i := scol to ecol do
            RTFEngine.AddColumn(Round(CurrentGrid.ColumnWidths[i]*14));
        end;
      end;
    end;

    RTFEngine.StartRow;
    CurrentGrid.ExportNotification(esExportNewRow,rg);

    for cg := scol to ecol do
    begin
      if Options.ExportHiddenColumns then
        creal := cg
      else
        creal := CurrentGrid.DisplToRealColumn(cg);

      //Merged Cells
      cp := TCellProperty(CurrentGrid.IntObjects[cg,rg]);

      if (cp <> nil) and not (cp.IsBaseCell(cg,rg)) and not CurrentGrid.IsYMergedCell(cg, rg) then
        Continue;                                // FF: Row merge Iss

          if Options.ExportCellProperties then
          begin
            CurrentGrid.DoGetCellClass(cg,  rg, cellclasstype);

            if (prevclasstype <> cellclasstype) and (prevclasstype <> nil) and Assigned(cell) then
            begin
              CurrentGrid.GetCellContainer.RemoveObject(cell);
              cell.Free;
            end;

            if (prevclasstype <> cellclasstype) then
            begin
              cell := cellclasstype.Create(Self);
              CurrentGrid.GetCellContainer.AddObject(cell);

              if (cell is TTMSFMXGridCell) then
              begin
                (cell as TTMSFMXGridCell).Layout.Font.OnChanged := nil;
                (cell as TTMSFMXGridCell).HitTest := False;
                (cell as TTMSFMXGridCell).BitmapContainer := CurrentGrid.BitmapContainer;
              end;
              prevclasstype := cellclasstype;
            end;

            if (Cell is TTMSFMXGridCell) then
            begin
              l.Assign((Cell as TTMSFMXGridCell).Layout);
              l.Assign(CurrentGrid.GetDefaultNormalLayout.Layout);

              CurrentGrid.DoGetCellLayout(cg, rg, l, TCellState.csNormal);
              (Cell as TTMSFMXGridCell).AssignLayout(l);
            end;

            CurrentGrid.DoGetCellAppearance(cg, rg, cell, TCellState.csNormal);
            CurrentGrid.DoGetCellProperties(cg, rg, cell);

            RTFEngine.AddFont(l.Font);
            if (RTFEngine.FontSize <> l.Font.Size*2) or (cg = GridStartCol) then
              RTFEngine.AddFontSize(Round(l.Font.Size*2));

            if (RTFEngine.ForeColor <> l.FontFill.Color) or (cg = GridStartCol) then
            begin
              RTFEngine.AddForeColor(l.FontFill.Color);
            end;

            if (RTFEngine.HAlignment <> l.TextAlign) or (cg = GridStartCol) then
              RTFEngine.AddHAlignment(l.TextAlign);

            if (TFontStyle.fsBold in l.Font.Style) then
            begin
              if not RTFEngine.Bold then
                RTFEngine.AddBold(True);
            end
            else
            begin
              if RTFEngine.Bold then
                RTFEngine.AddBold(False);
            end;

            if (TFontStyle.fsItalic in l.Font.Style) then
            begin
              if not RTFEngine.Italic then
                RTFEngine.AddItalic(True);
            end
            else
            begin
              if RTFEngine.Italic then
                RTFEngine.AddItalic(False);
            end;

            if (TFontStyle.fsUnderLine in l.Font.Style) then
            begin
              if not RTFEngine.UnderLine then
                RTFEngine.AddUnderLine(True);
            end
            else
            begin
              if RTFEngine.UnderLine then
                RTFEngine.AddUnderLine(False);
            end;
          end;

          if Options.ExportBackGround and Options.ExportMsWordFeatures {and (ABrush.Color <> claWhite)} then
          begin
            if l.Fill.Color = claNull then
              RTFEngine.AddCellColor(claWhite)
            else
              RTFEngine.AddCellColor(l.Fill.Color);
          end;


      skipCell := Options.ExportSelectedCells {and not CurrentGrid.SelectedCells[creal, rg]} and not (CurrentGrid.IsFixed(cg, rg));

      // Checkbox
      (*
      CellGraphic := CurrentGrid.CellGraphics[{cg}creal, rg];
      if (CellGraphic <> nil) and not skipCell then
      begin
        if (CellGraphic.CellType in [ctCheckBox, ctDataCheckBox]) then
        begin
          Pic := TPicture.Create;
          if CellGraphic.CellBoolean then
            Pic.Bitmap.LoadFromResourceName(hinstance,'ASGRTFCHK01')
          else
            Pic.Bitmap.LoadFromResourceName(hinstance,'ASGRTFCHK02');
          RTFEngine.AddPicture(Pic);
          Pic.Free;
        end
        else
          AddCellGraphics(CellGraphic);
      end;
      *)

      //Export Images
      if Options.ExportImages and not SkipCell then
      begin
        PicName := CurrentGrid.GetBitmapName(cg, rg);

        if (PicName <> '') and Assigned(CurrentGrid.BitmapContainer) then
        begin
          RTFEngine.AddBitmap(CurrentGrid.BitmapContainer.FindBitmap(picname), l.Fill.Color);
        end;
      end;


      CellData := CurrentGrid.Cells[creal, rg];
      if CurrentGrid.Options.IO.SaveVirtualCellData then
        CurrentGrid.DoGetCellData(cg, rg, CellData);
      if skipCell then
        CellData := '';

      // do not export text of a checkbox
      //if CurrentGrid.HasCheckBox(creal,rg) then
        //CellData := '';

      if (pos('</',CellData) > 0) and Options.ConvertHTML then
      begin
        AFont := TFont.Create;
        try
          HTMLToRTF(CellData, AFont, RTFEngine);
        finally
          AFont.Free;
        end;
        //RTFEngine.AddHTML(CellData);
      end
      else if IsHyperLink(CellData) {and CurrentGrid.URLShow} then
      begin
        AFont := TFont.Create;
        AFont.Assign(CurrentGrid.GetDefaultFont(cg,rg));
        try
        //AFont.Color := CurrentGrid.URLColor;
          RTFEngine.AddHyperLink(CellData, CellData, AFont);
        finally
          AFont.Free;
        end;
      end
      else
        RTFEngine.AddText(CellData);

      //if (CellGraphic <> nil) and not skipCell then
      //  AddCellGraphics(CellGraphic);


      //Pic := CurrentGrid.GetPicture(cg, rg);
      //if Options.ExportImages and (Pic <> nil) and not skipCell then
      //begin
      //  RTFEngine.AddPicture(Pic);
      //end;

      RTFEngine.NextCell;
    end;
    RTFEngine.EndRow;

    if Assigned(FOnPageBreak) then
    begin
      DoPageBreak := False;
      FOnPageBreak(self, rg - GridStartRow, DoPageBreak);
      if DoPageBreak then
        RTFEngine.AddPageBreak;
    end;

    if Assigned(FOnProgress) then
      FOnProgress(Self, rg - GridStartRow, CurrentGrid.RowCount - 1 - GridStartRow);
  end;

  RTFEngine.EndTable;

  if (Options.Footer <> '') then
  begin
    {$IFDEF DELPHIXE6_LVL}
    RTFEngine.AddHAlignment(TTextAlign.Center);  // Since table is Center Aligned
    {$ELSE}
    RTFEngine.AddHAlignment(TTextAlign.taCenter);  // Since table is Center Aligned
    {$ENDIF}
    RTFEngine.AddForeColor(claBlack);
    RTFEngine.AddText(Options.Footer);
  end;

  try
    case ExportMode of
      emFile: RTFEngine.SaveToFile(FileName);
      emStream: RTFEngine.SaveToStream(st);
      emString: S := RTFEngine.GetText;
      emBuffer: RTFEngine.GetBuffer(S, FFontBuffer, FColorBuffer);
    end;

    {     if ColorToRGB(ABrush.Color) = $FFFFFF then
          begin
            Fm.FillPattern.Pattern := 1; //no fill
          end else
          begin
            Fm.FillPattern.Pattern := 2; //Solid fill
            Fm.FillPattern.FgColorIndex := MatchNearestColor(Workbook, ColorToRGB(ABrush.Color));
          end;

          if FUseUnicode then
            w := SupressCR(CurrentGrid.WideCells[creal, rg])
          else
            w := SupressCR(CurrentGrid.SaveCell(creal, rg));

          Formula := SupressCR(CurrentGrid.SaveCell(creal, rg));

          if not Options.ExportHTMLTags then
          begin
            StringReplace(w,'<br>','#13#10',[rfReplaceAll, rfIgnoreCase]);
          end;

          if (pos('</',w) > 0) and not Options.ExportHTMLTags then
            w := HTMLStrip(w);

          //Cell Align
          case HA of
            taLeftJustify: Fm.HAlignment := fha_left;
            taCenter: Fm.HAlignment := fha_center;
            taRightJustify: Fm.HAlignment := fha_right;
          else Fm.HAlignment := fha_general;
          end; //case

          case VA of
            vtaTop: Fm.VAlignment := fva_top;
            vtaCenter: Fm.VAlignment := fva_center;
          else Fm.VAlignment := fva_bottom;
          end; //case

          if Assigned(OnCellFormat) then
            OnCellFormat(CurrentGrid, creal, rg, cx, rx, w, Fm);

              Workbook.CellValue[rx, cx] := w;
              if Options.ExportCellProperties then
              begin
                Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
              CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
              end;
            end;
          end;
        finally
          FreeAndNil(ABrush);
        end; //finally
      finally
        FreeAndNil(AFont);
      end; //finally

    end;

    //Export Nodes
    if Options.ExportCellProperties then
      if (CurrentGrid.GetNodeLevel(rg)>=0) and (CurrentGrid.GetNodeLevel(rg)<=7) then
        Workbook.SetRowOutlineLevel(rx+1, rx+CurrentGrid.GetNodeSpan(rg)-1, CurrentGrid.GetNodeLevel(rg));
  end;
  }
  CurrentGrid.ExportNotification(esExportDone,-1);

  if Options.ExportHiddenColumns and not Options.ExportSelectedCells then
    CurrentGrid.ColumnCount := CurrentGrid.ColumnCount - HiddenCount;

  finally
    RTFEngine.Free;
    l.Free;
    if Assigned(cell) then
    begin
      CurrentGrid.GetCellContainer.RemoveObject(cell);
      cell.Free;
    end;
  end;

  if Options.ExportShowInWord and (ExportMode = emFile) then
  begin
    {$IFDEF DELPHI_LLVM}
    XOpenFile(FileName);
    {$ELSE}
    XOpenFile('open', FileName, '', '');
    {$ENDIF}
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXGridRTFIO.ExportToString: string;
begin
  ExportInternal('', nil, Result, emString);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.ExportToBuffer;
begin
  FBuffer := '';
  ExportInternal('', nil, FBuffer, emBuffer);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXGridRTFIO.ExportToStream(st: TStream);
var
  S: String;
begin
  S := '';
  ExportInternal('', st, S, emStream);
end;

//------------------------------------------------------------------------------

end.
