{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBGridExport.pas, released on 2004-01-15

The Initial Developer of the Original Code is Lionel Reynaud
Portions created by Lionel Reynaud are Copyright (C) 2004 Lionel Reynaud.
All Rights Reserved.

Contributor(s): Marc Geldon

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvDBGridExport;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Classes, SysUtils, DB, DBGrids,
  JvComponentBase, JvSimpleXml, JvTypes;

type
  TExportDestination = (edFile, edClipboard);
  TExportSeparator = (esTab, esSemiColon, esComma, esSpace, esPipe);
  TWordOrientation = (woPortrait, woLandscape);

  EJvExportDBGridException = class(EJVCLException);
  TJvWordGridFormat = $10..$17;

  TOleServerClose = (scNever, scNewInstance, scAlways);

  TRecordColumn = record
    Visible: Boolean;
    Exportable: Boolean;
    ColumnName: string;
    Column: TColumn;
    Field: TField;
  end;

{ avoid Office TLB imports }
const
  wdDoNotSaveChanges = 0;

  wdTableFormatGrid1 = TJvWordGridFormat($10);
  wdTableFormatGrid2 = TJvWordGridFormat($11);
  wdTableFormatGrid3 = TJvWordGridFormat($12);
  wdTableFormatGrid4 = TJvWordGridFormat($13);
  wdTableFormatGrid5 = TJvWordGridFormat($14);
  wdTableFormatGrid6 = TJvWordGridFormat($15);
  wdTableFormatGrid7 = TJvWordGridFormat($16);
  wdTableFormatGrid8 = TJvWordGridFormat($17);

  xlPortrait = $01;
  xlLandscape = $02;

type
  TJvExportProgressEvent = procedure(Sender: TObject; Min, Max, Position: Cardinal;
    const AText: string; var AContinue: Boolean) of object;

  TJvCustomDBGridExport = class(TJvComponent)
  private
    FGrid: TDBGrid;
    FColumnCount: Integer;
    FRecordColumns: array of TRecordColumn;
    FCaption: string;
    FFileName: TFileName;
    FOnProgress: TJvExportProgressEvent;
    FLastExceptionMessage: string;
    FSilent: Boolean;
    FOnException: TNotifyEvent;
    FUseFieldGetText: Boolean;
    procedure CheckVisibleColumn;
  protected
    procedure HandleException;
    function ExportField(AField: TField): Boolean;
    function DoProgress(Min, Max, Position: Cardinal; const AText: string): Boolean; virtual;
    function DoExport: Boolean; virtual; abstract;
    procedure DoSave; virtual;
    procedure DoClose; virtual; abstract;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetFieldValue(const Field: TField): Variant; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    function ExportGrid: Boolean;
  published
    // (p3) these should be published: all exporters must support them
    property Caption: string read FCaption write FCaption;
    property UseFieldGetText: Boolean read FUseFieldGetText write FUseFieldGetText default False;
    property Grid: TDBGrid read FGrid write FGrid;
    property FileName: TFileName read FFileName write FFileName;
    property Silent: Boolean read FSilent write FSilent default True;
    property OnProgress: TJvExportProgressEvent read FOnProgress write FOnProgress;
    property OnException: TNotifyEvent read FOnException write FOnException;
    property LastExceptionMessage: string read FLastExceptionMessage;
  end;

  TJvCustomDBGridExportClass = class of TJvCustomDBGridExport;

  { TJvCustomDBGridOleExport converts any string-variant that isn't supported
    by OLE to an OleStr variant. }
  TJvCustomDBGridOleExport = class(TJvCustomDBGridExport)
  protected
    function GetFieldValue(const Field: TField): Variant; override;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDBGridWordExport = class(TJvCustomDBGridOleExport)
  private
    FWord: OleVariant;
    FVisible: Boolean;
    FOrientation: TWordOrientation;
    FWordFormat: TJvWordGridFormat;
    FClose: TOleServerClose;
    FRunningInstance: Boolean;
  protected
    procedure DoSave; override;
    function DoExport: Boolean; override;
    procedure DoClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;
    property Close: TOleServerClose read FClose write FClose default scNewInstance;
    property WordFormat: TJvWordGridFormat read FWordFormat write FWordFormat default wdTableFormatGrid3;
    property Visible: Boolean read FVisible write FVisible default False;
    property Orientation: TWordOrientation read FOrientation write FOrientation default woPortrait;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDBGridExcelExport = class(TJvCustomDBGridOleExport)
  private
    FExcel: OleVariant;
    FVisible: Boolean;
    FAutoFit: Boolean;
    FHeaderRow: Boolean;
    FOrientation: TWordOrientation;
    FClose: TOleServerClose;
    FRunningInstance: Boolean;
    function IndexFieldToExcel(Index: Integer): string;
  protected
    procedure DoSave; override;
    function DoExport: Boolean; override;
    procedure DoClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;
    property Close: TOleServerClose read FClose write FClose default scNewInstance;
    property Visible: Boolean read FVisible write FVisible default False;
    property Orientation: TWordOrientation read FOrientation write FOrientation default woPortrait;
    property AutoFit: Boolean read FAutoFit write FAutoFit;
    property HeaderRow: Boolean read FHeaderRow write FHeaderRow default True;
  end;

  TJvCustomDBGridTextExport = class(TJvCustomDBGridExport)
  private
    {$IFDEF UNICODE}
    FEncoding: TEncoding;
    {$ENDIF UNICODE}
  public
    {$IFDEF UNICODE}
    property Encoding: TEncoding read FEncoding write FEncoding;
    {$ENDIF UNICODE}
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDBGridHTMLExport = class(TJvCustomDBGridTextExport)
  private
    FDocument: TStrings;
    FDocTitle: string;
    FHeader: TStrings;
    FFooter: TStrings;
    FIncludeColumnHeader: Boolean;
    procedure SetHeader(const Value: TStrings);
    procedure SetFooter(const Value: TStrings);
  protected
    procedure DoSave; override;
    function DoExport: Boolean; override;
    procedure DoClose; override;
    procedure SetDefaultData;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GenerateHTMLText: string;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;
    property IncludeColumnHeader: Boolean read FIncludeColumnHeader write FIncludeColumnHeader default True;
    property Header: TStrings read FHeader write SetHeader;
    property Footer: TStrings read FFooter write SetFooter;
    property DocTitle: string read FDocTitle write FDocTitle;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDBGridCSVExport = class(TJvCustomDBGridTextExport)
  private
    FDocument: TStrings;
    FDestination: TExportDestination;
    FExportSeparator: TExportSeparator;
    FShowColumnName: Boolean;
    FQuoteEveryTime: Boolean;
    FSeparator: string;
    procedure SetExportSeparator(const Value: TExportSeparator);
    function SeparatorToString(ASeparator: TExportSeparator): string;
    procedure SetDestination(const Value: TExportDestination);
  protected
    function DoExport: Boolean; override;
    procedure DoSave; override;
    procedure DoClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Separator: string read FSeparator write FSeparator;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;

    property Destination: TExportDestination read FDestination write SetDestination default edFile;
    property ExportSeparator: TExportSeparator read FExportSeparator write SetExportSeparator default esTab;
    property ShowColumnName: Boolean read FShowColumnName write FShowColumnName default True;
    property QuoteEveryTime: Boolean read FQuoteEveryTime write FQuoteEveryTime default True;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDBGridXMLExport = class(TJvCustomDBGridTextExport)
  private
    FXML: TJvSimpleXML;
    function ClassNameNoT(AField: TField): string;
  protected
    function DoExport: Boolean; override;
    procedure DoSave; override;
    procedure DoClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // accessible so that people can set options prior export (prolog in particular)
    property XML: TJvSimpleXML read FXML;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;
  end;

function WordGridFormatIdentToInt(const Ident: string; var Value: Longint): Boolean;
function IntToWordGridFormatIdent(Value: Longint; var Ident: string): Boolean;
procedure GetWordGridFormatValues(Proc: TGetStrProc);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Revision$';
    Date: '$Date$';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Variants, ComObj, Graphics, Clipbrd,
  JclRegistry,
  JvConsts, JvResources, JclStreams;

//=== { TJvCustomDBGridExport } ==============================================

constructor TJvCustomDBGridExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSilent := True;
end;

function TJvCustomDBGridExport.DoProgress(Min, Max, Position: Cardinal;
  const AText: string): Boolean;
begin
  Result := True;
  if Assigned(FOnProgress) then
    FOnProgress(Self, Min, Max, Position, AText, Result);
end;

procedure TJvCustomDBGridExport.DoSave;
begin
  if FileExists(FileName) then
    DeleteFile(FileName);
end;

function TJvCustomDBGridExport.ExportField(AField: TField): Boolean;
begin
  Result := not (AField.DataType in [ftUnknown, ftBlob, ftGraphic,
    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT,
    ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant,
    ftInterface, ftIDispatch, ftGuid]);
end;

procedure TJvCustomDBGridExport.CheckVisibleColumn;
var
  I: Integer;
begin
  FColumnCount := Grid.Columns.Count;
  SetLength(FRecordColumns, FColumnCount);
  for I := 0 to FColumnCount - 1 do
  begin
    FRecordColumns[I].Column := Grid.Columns[I];
    FRecordColumns[I].Visible := Grid.Columns[I].Visible;
    FRecordColumns[I].ColumnName := Grid.Columns[I].Title.Caption;
    FRecordColumns[I].Field := Grid.Columns[I].Field;
    if FRecordColumns[I].Visible and (FRecordColumns[I].Field <> nil) then
      FRecordColumns[I].Exportable := ExportField(FRecordColumns[I].Field)
    else
      FRecordColumns[I].Exportable := False;
  end;
end;

function TJvCustomDBGridExport.ExportGrid: Boolean;
begin
  if not Assigned(Grid) then
    raise EJvExportDBGridException.CreateRes(@RsEGridIsUnassigned);
  if not Assigned(Grid.DataSource) or not Assigned(Grid.DataSource.DataSet) then
    raise EJvExportDBGridException.CreateRes(@RsEDataSetDataSourceIsUnassigned);
//  if FileName = '' then
//    raise EJvExportDBGridException.Create(RsFilenameEmpty);
  CheckVisibleColumn;
  Result := DoExport;
  if Result then
    DoSave;
  DoClose;
end;

function TJvCustomDBGridExport.GetFieldValue(const Field: TField): Variant;
var
  Str: String;
begin
  if Assigned(Field.OnGetText) and FUseFieldGetText then
  begin
    Field.OnGetText(Field, Str, True);
    Result := Str;
  end
  else
    Result := Field.Value;
end;

procedure TJvCustomDBGridExport.HandleException;
begin
  if ExceptObject <> nil then
  begin
    if ExceptObject is Exception then
      FLastExceptionMessage := Exception(ExceptObject).Message;
    if not Silent then
      raise ExceptObject at ExceptAddr
    else
    if Assigned(FOnException) then
      FOnException(Self);
  end;
end;

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

//=== { TJvCustomDBGridOleExport } ============?==============================

function TJvCustomDBGridOleExport.GetFieldValue(const Field: TField): Variant;
begin
  Result := inherited GetFieldValue(Field);
  if VarType(Result) >= varString then // OleStr ist the only string type that is supported
    Result := WideString(Result);
end;

//=== { TJvDBGridWordExport } ================================================

constructor TJvDBGridWordExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := RsExportWord;
  FWord := Unassigned;
  FVisible := False;
  FOrientation := woPortrait;
  FWordFormat := wdTableFormatGrid3;
  FClose := scNewInstance;
end;

destructor TJvDBGridWordExport.Destroy;
begin
  DoClose;
  inherited Destroy;
end;

function TJvDBGridWordExport.DoExport: Boolean;
const
  cWordApplication = 'Word.Application';
var
  I, J, K: Integer;
  lTable: OleVariant;
  ARecNo, lRecCount: Integer;
  lColVisible: Integer;
  lRowCount: Integer;
  lBookmark: TBookmark;
begin
  Result := True;
  FRunningInstance := True;
  try
    // get running instance
    FWord := GetActiveOleObject(cWordApplication);
  except
    FRunningInstance := False;
    try
      // create new
      FWord := CreateOleObject(cWordApplication);
    except
      FWord := Unassigned;
      HandleException;
//      raise EJvExportDBGridException.Create(RsNoWordApplication);
    end;
  end;

  if VarIsEmpty(FWord) then
    begin
      Result := False;
      Exit;
    end;

  try
    if not FRunningInstance then
      FWord.Visible := FVisible;
    FWord.Documents.Add;

    lColVisible := 0;
    for I := 1 to FColumnCount do
      if Grid.Columns[I - 1].Visible then
        Inc(lColVisible);

    lRowCount := Grid.DataSource.DataSet.RecordCount;
    FWord.ActiveDocument.Range.Font.Name := Grid.Font.Name;
    FWord.ActiveDocument.Range.Font.Size := Grid.Font.Size;
    if Orientation = woPortrait then
      FWord.ActiveDocument.PageSetup.Orientation := 0
    else
      FWord.ActiveDocument.PageSetup.Orientation := 1;
    lTable := FWord.ActiveDocument.Tables.Add(FWord.ActiveDocument.Range, lRowCount + 1, lColVisible);
    FWord.ActiveDocument.Range.InsertAfter('Date ' + DateTimeToStr(Now));
    // (rom) This is correct Delphi. See "positional parameters" in the Delphi help.
    lTable.AutoFormat(Format := WordFormat); // FormatNum, 1, 1, 1, 1, 1, 0, 0, 0, 1

    K := 1;
    for I := 0 to FColumnCount - 1 do
      if FRecordColumns[I].Visible then
      begin
        lTable.Cell(1, K).Range.InsertAfter(FRecordColumns[I].ColumnName);
        Inc(K);
      end;

    J := 2;
    with Grid.DataSource.DataSet do
    begin
      lRecCount := RecordCount;
      ARecNo := 0;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          K := 1;
          for I := 0 to FColumnCount - 1 do
          begin
            if FRecordColumns[I].Exportable and not FRecordColumns[I].Field.IsNull then
            begin
              try
                lTable.Cell(J, K).Range.InsertAfter(GetFieldValue(FRecordColumns[I].Field));
              except
                Result := False;
                HandleException;
                // Remember problem but continue
              end;
            end;
            if FRecordColumns[I].Visible then
              Inc(K);
          end;
          Next;
          Inc(J);
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
    lTable.UpdateAutoFormat;
  except
    HandleException;
    Result := False;
  end;
end;

procedure TJvDBGridWordExport.DoSave;
var
  lName: OleVariant;
begin
  inherited DoSave;
  if VarIsEmpty(FWord) then
    Exit;
  try
    lName := OleVariant(FileName);
    FWord.ActiveDocument.SaveAs(lName);
  except
    HandleException;
  end;
end;

procedure TJvDBGridWordExport.DoClose;
begin
  if not VarIsEmpty(FWord) and (FClose <> scNever) then
  try
    if (FClose = scAlways) or not FRunningInstance then
    begin
      FWord.ActiveDocument.Close(wdDoNotSaveChanges, EmptyParam, EmptyParam);
      FWord.Quit;
    end;
    FWord := Unassigned;
  except
    HandleException;
  end;
end;

//=== { TJvDBGridExcelExport } ===============================================

constructor TJvDBGridExcelExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := RsExportExcel;
  FExcel := Unassigned;
  FVisible := False;
  FHeaderRow := True;
  FOrientation := woPortrait;
  FClose := scNewInstance;
end;

destructor TJvDBGridExcelExport.Destroy;
begin
  DoClose;
  inherited Destroy;
end;

function TJvDBGridExcelExport.IndexFieldToExcel(Index: Integer): string;
begin
  // Max column : ZZ => Index = 702
  if Index > 26 then
    Result := Chr(64 + ((Index - 1) div 26)) + Chr(65 + ((Index - 1) mod 26))
  else
    Result := Chr(64 + Index);
end;

function TJvDBGridExcelExport.DoExport: Boolean;
const
  cExcelApplication = 'Excel.Application';
var
  I, J, K: Integer;
  lTable: OleVariant;
  lCell: OleVariant;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
begin
  Result := True;
  FRunningInstance := True;
  try
    // get running instance
    FExcel := GetActiveOleObject(cExcelApplication);
  except
    FRunningInstance := False;
    try
      // create new instance
      FExcel := CreateOleObject(cExcelApplication);
    except
      FExcel := Unassigned;
      HandleException;
    end;
  end;

  if VarIsEmpty(FExcel) then
    begin
      Result := False;
      Exit;
    end;
  try
    if not FRunningInstance then
      FExcel.Visible := Visible;
    FExcel.WorkBooks.Add;

    lTable := FExcel.ActiveWorkbook.ActiveSheet;

    if Orientation = woPortrait then
      lTable.PageSetup.Orientation := xlPortrait
    else
      lTable.PageSetup.Orientation := xlLandscape;

    K := 1;
    for I := 0 to FColumnCount - 1 do
      if FRecordColumns[I].Visible then
      begin
        lCell := lTable.Range[IndexFieldToExcel(K) + '1'];
        lCell.Value := FRecordColumns[I].ColumnName;
        Inc(K);
      end;

    J := 0;
    if HeaderRow then
      J := 1;
    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          Inc(J);
          K := 1;
          for I := 0 to FColumnCount - 1 do
          begin
            if FRecordColumns[I].Exportable then
            begin
              lCell := lTable.Range[IndexFieldToExcel(K) + IntToStr(J)];
              try
                lCell.Value := GetFieldValue(FRecordColumns[I].Field);
              except
                Result := False;
                HandleException;
              end;
            end;
            if FRecordColumns[I].Visible then
              Inc(K);
          end;
          Next;
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        if AutoFit then
          try
            lTable.Columns.AutoFit; // NEW! Autofit!
          except
             {$IFDEF DEBUGINFO_ON}
             on E: Exception do
               OutputDebugString(PChar('lTable.Columns.AutoFit failed. ' + E.Message));
             {$ENDIF DEBUGINFO_ON}
          end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
    Result := False;
  end;
end;

procedure TJvDBGridExcelExport.DoSave;
var
  lName: OleVariant;
begin
  inherited DoSave;
  if not VarIsEmpty(FExcel) then
  try
    lName := OleVariant(FileName);
    FExcel.ActiveWorkbook.SaveAs(lName);
  except
    HandleException;
  end;
end;

procedure TJvDBGridExcelExport.DoClose;
begin
  if not VarIsEmpty(FExcel) and (FClose = scNever) then
  begin
    FExcel.Visible := True;
    Exit;
  end;

  if not VarIsEmpty(FExcel) and (FClose <> scNever) then
  try
    FExcel.ActiveWorkbook.Saved := True; // Avoid Excel's save prompt
    if (Close = scAlways) or not FRunningInstance then
    begin
      FExcel.ActiveWorkbook.Close;
      FExcel.Quit;
    end;
    FExcel := Unassigned;
  except
    HandleException;
  end;
end;

//=== { TJvDBGridHTMLExport } ================================================

constructor TJvDBGridHTMLExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDocument := TStringList.Create;
  Caption := RsExportHTML;
  FDocTitle := RsHTMLExportDocTitle;
  FHeader := TStringList.Create;
  FFooter := TStringList.Create;
  FIncludeColumnHeader := True;
  SetDefaultData;
end;

destructor TJvDBGridHTMLExport.Destroy;
begin
  FFooter.Free;
  FHeader.Free;
  FDocument.Free;
  inherited Destroy;
end;

procedure TJvDBGridHTMLExport.SetDefaultData;
begin
  Header.Add('<html><head><title><#TITLE></title>');
  Header.Add('<style type=text/css>');
  Header.Add('#STYLE');
  Header.Add('</style>');
  Header.Add('</head><body>');

  Footer.Add('</body></html>');   
end;

procedure TJvDBGridHTMLExport.SetFooter(const Value: TStrings);
begin
  FFooter.Assign(Value);
end;

procedure TJvDBGridHTMLExport.SetHeader(const Value: TStrings);
begin
  FHeader.Assign(Value);
end;

function TJvDBGridHTMLExport.GenerateHTMLText: string;
begin
  if not Assigned(Grid) then
    raise EJvExportDBGridException.CreateRes(@RsEGridIsUnassigned);
  if not Assigned(Grid.DataSource) or not Assigned(Grid.DataSource.DataSet) then
    raise EJvExportDBGridException.CreateRes(@RsEDataSetDataSourceIsUnassigned);
  CheckVisibleColumn;
  if DoExport then
    Result := FDocument.Text
  else
    Result := '';
end;

procedure TJvDBGridHTMLExport.DoClose;
begin
 // do nothing
end;

function TJvDBGridHTMLExport.DoExport: Boolean;
var
  I: Integer;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
  lString, lText, lHeader, lStyle: string;

  function AlignmentToHTML(AAlign: TAlignment): string;
  begin
    case AAlign of
      taLeftJustify:
        Result := 'left';
      taRightJustify:
        Result := 'right';
      taCenter:
        Result := 'center';
    end;
  end;

  function ColorToHTML(AColor: TColor): string;
  var
    r, g, b: byte;
  begin
    AColor := ColorToRGB(AColor);
    r := GetRValue(AColor);
    g := GetGValue(AColor);
    b := GetBValue(AColor);
    Result := Format('%.2x%.2x%.2x', [r, g, b]);
  end;

  function FontSubstitute(const Name: string): string;
  const
    cFontKey: array [Boolean] of PChar =
     ('SOFTWARE\Microsoft\Windows\CurrentVersion\FontSubstitutes',
      'SOFTWARE\Microsoft\Windows NT\CurrentVersion\FontSubstitutes');
  begin
    Result := RegReadStringDef(HKLM,
      cFontKey[Win32Platform = VER_PLATFORM_WIN32_NT], Name, Name);
  end;

  function FontSizeToHTML(PtSize: Integer): Integer;
  begin
    case Abs(PtSize) of
      0..8:
        Result := 1;
      9..10:
        Result := 2;
      11..12:
        Result := 3;
      13..17:
        Result := 4;
      18..23:
        Result := 5;
      24..35:
        Result := 6;
    else
      Result := 7;
    end;
  end;

  function FontToHTML(AFont: TFont; EncloseText: string): string;
  begin
    if fsBold in AFont.Style then
      EncloseText := '<b>' + EncloseText + '</b>';
    if fsItalic in AFont.Style then
      EncloseText := '<i>' + EncloseText + '</i>';
    if fsUnderline in AFont.Style then
      EncloseText := '<u>' + EncloseText + '</u>';
    if fsStrikeout in AFont.Style then
      EncloseText := '<s>' + EncloseText + '</s>';
    Result := Format('<font face="%s" color="#%s" size="%d">%s</font>',
      [FontSubstitute(AFont.Name), ColorToHTML(AFont.Color), FontSizeToHTML(AFont.Size), EncloseText]);
  end;

  function FontStyleToHTML(AFont: TFont): string;
  begin
    Result := '';
    if fsBold in AFont.Style then
      Result := 'FONT-WEIGHT: bold; ';
    if fsItalic in AFont.Style then
      Result := Result + 'FONT-STYLE: italic; ';
    if fsUnderline in AFont.Style then
      if fsStrikeout in AFont.Style then
        Result := Result + 'TEXT-DECORATION: underline line-through; '
      else
        Result := Result + 'TEXT-DECORATION: underline; '
    else
    if fsStrikeout in AFont.Style then
      Result := Result + 'TEXT-DECORATION: line-through; ';
  end;

begin
  FDocument.Clear;

  Result := True;
  try
    // Create Style like :
    //.Column0 {FONT-FAMILY: Arial; FONT-SIZE: 12px; FONT-WEIGHT: bold; FONT-STYLE: italic
    //      TEXT-ALIGN: right; COLOR: #FFFFFF; BACKGROUND: #9924A7}

    lStyle := '';
    lString := '<tr>';
    for I := 0 to FColumnCount - 1 do
      if FRecordColumns[I].Visible then
        with FRecordColumns[I].Column do
        begin
          lString := lString + Format('<th bgcolor="#%s" align="%s">%s</th>',
            [ColorToHTML(Title.Color), AlignmentToHTML(Alignment), FontToHTML(Title.Font, Title.Caption)]);
          lStyle := lStyle +
            Format('.Column%d {FONT-FAMILY: %s; FONT-SIZE: %dpt; %s TEXT-ALIGN: %s; COLOR: #%s; BACKGROUND: #%s;}'#13#10,
            [I, FontSubstitute(Font.Name), Font.Size, FontStyleToHTML(Font),
            AlignmentToHTML(Alignment), ColorToHTML(Font.Color), ColorToHTML(Color)]);
        end;
    lString := lString + '</tr>';
    lHeader := StringReplace(Header.Text, '<#TITLE>', DocTitle, [rfReplaceAll, rfIgnoreCase]);
    lHeader := StringReplace(lHeader, '#STYLE', lStyle, [rfReplaceAll, rfIgnoreCase]);

    FDocument.Add(lHeader);
    FDocument.Add('<table width="90%" border="1" cellspacing="0" cellpadding="0">');
    if IncludeColumnHeader then
      FDocument.Add(lString);

    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          lString := '<tr>';
          for I := 0 to FColumnCount - 1 do
            with FRecordColumns[I] do
              if Visible then
              begin
                if Exportable and not Field.IsNull then
                try
                  lText := GetFieldValue(Field);
                  if lText = '' then
                    lText := '&nbsp;';
                except
                  Result := False;
                  HandleException;
                end
                else
                  lText := '&nbsp;';

                lString := lString + Format('<td class="column%d">%s</td>',
                  [I, lText]);
              end;
          lString := lString + '</tr>';
          FDocument.Add(lString);
          Next;
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        FDocument.Add('</table>');
        FDocument.AddStrings(Footer);
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
    Result := False;
  end;
end;

procedure TJvDBGridHTMLExport.DoSave;
begin
  inherited DoSave;
  FDocument.SaveToFile(FileName {$IFDEF UNICODE}, Encoding{$ENDIF});
end;

//=== { TJvDBGridCSVExport } =================================================

constructor TJvDBGridCSVExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDocument := TStringList.Create;
  FDestination := edFile;
  ExportSeparator := esTab;
  Caption := RsExportFile;
  FShowColumnName := True;
  FQuoteEveryTime := True;
end;

destructor TJvDBGridCSVExport.Destroy;
begin
  FDocument.Free;
  inherited Destroy;
end;

function TJvDBGridCSVExport.SeparatorToString(ASeparator: TExportSeparator): string;
begin
  case ASeparator of
    esTab:
      Result := Tab;
    esSemiColon:
      Result := ';';
    esComma:
      Result := ',';
    esSpace:
      Result := ' ';
    esPipe:
      Result := '|';
  end;
end;

procedure TJvDBGridCSVExport.SetExportSeparator(const Value: TExportSeparator);
begin
  FExportSeparator := Value;
  Separator := SeparatorToString(FExportSeparator);
end;

procedure TJvDBGridCSVExport.SetDestination(const Value: TExportDestination);
begin
  FDestination := Value;
  if FDestination = edFile then
    Caption := RsExportFile
  else
    Caption := RsExportClipboard;
end;

function TJvDBGridCSVExport.DoExport: Boolean;
var
  I: Integer;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
  lString, lField: string;
begin
  FDocument.Clear;
  Result := True;
  try
    if ShowColumnName then
    begin
      lString := '';
      for I := 0 to FColumnCount - 1 do
        if FRecordColumns[I].Visible then
          if lString = '' then
            lString := FRecordColumns[I].ColumnName
          else
            lString := lString + Separator + FRecordColumns[I].ColumnName;
      FDocument.Add(lString);
    end;

    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          lString := '';
          for I := 0 to FColumnCount - 1 do
          begin
            if FRecordColumns[I].Exportable then
            begin
              try
                if not FRecordColumns[I].Field.IsNull then
                begin
                  lField := GetFieldValue(FRecordColumns[I].Field);
                  if (Pos(Separator, lField) <> 0) or (FQuoteEveryTime) then
                    lString := lString + AnsiQuotedStr(lField, '"')
                  else
                    lString := lString + lField;
                end;
              except
                Result := False;
                HandleException;
              end;
            end;
            if FRecordColumns[I].Visible then
              lString := lString + Separator;
          end;
          FDocument.Add(lString);
          Next;
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
    Result := False;
  end;
end;

procedure TJvDBGridCSVExport.DoSave;
begin
  inherited DoSave;
  if Destination = edFile then
    FDocument.SaveToFile(FileName {$IFDEF UNICODE}, Encoding{$ENDIF})
  else
    Clipboard.AsText := FDocument.Text;
end;

procedure TJvDBGridCSVExport.DoClose;
begin
  // do nothing
end;

//=== { TJvDBGridXMLExport } =================================================

constructor TJvDBGridXMLExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FXML := TJvSimpleXML.Create(nil);
  FXML.Options := [sxoAutoCreate, sxoAutoIndent];
end;

destructor TJvDBGridXMLExport.Destroy;
begin
  FXML.Free;
  inherited Destroy;
end;

// From DSDEfine of Delphi designer

function TJvDBGridXMLExport.ClassNameNoT(AField: TField): string;
begin
  Result := AField.ClassName;
  if Result[1] = 'T' then
    Delete(Result, 1, 1);
  if SameText('Field', Copy(Result, Length(Result) - 4, 5)) then { do not localize }
    Delete(Result, Length(Result) - 4, 5);
end;

// The structure of the xml file is inspired of the xml export
// create by Delphi with TClientDataSet

function TJvDBGridXMLExport.DoExport: Boolean;
var
  I: Integer;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
  lRootNode: TJvSimpleXmlElemClassic;
  lDataNode: TJvSimpleXmlElem;
  lFieldsNode: TJvSimpleXmlElem;
  lRecordNode: TJvSimpleXmlElem;
begin
  Result := True;
  FXML.Root.Clear;

  // create root node
  FXML.Root.Name := 'DATAPACKET';
  lRootNode := FXML.Root;
  lRootNode.Properties.Add('Version', '1.0'); // This is the first implementation !

  // add column header and his property
  lDataNode := lRootNode.Items.Add('METADATA');
  lFieldsNode := lDataNode.Items.Add('FIELDS');
  for I := 0 to FColumnCount - 1 do
    with FRecordColumns[I] do
      if Visible and (Field <> nil) then
      begin
        with lFieldsNode.Items.Add('FIELD') do
        begin
          Properties.Add('ATTRNAME', ColumnName);
          Properties.Add('FIELDTYPE', ClassNameNoT(Field));
          Properties.Add('WIDTH', Column.Width);
        end;
      end;

  // now add all the record
  lRecordNode := lRootNode.Items.Add('ROWDATA');
  try
    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          with lRecordNode.Items.Add('ROW') do
          begin
            for I := 0 to FColumnCount - 1 do
              if FRecordColumns[I].Exportable then
              begin
                try
                  Properties.Add(FRecordColumns[I].ColumnName, VarToStr(GetFieldValue(FRecordColumns[I].Field)));
                except
                  Result := False;
                  HandleException;
                end
              end;
          end;
          Next;
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
    Result := False;
  end;
end;

procedure TJvDBGridXMLExport.DoSave;
var
  XmlEncoding: TJclStringEncoding;
begin
  inherited DoSave;
  XmlEncoding := seAuto;
  {$IFDEF UNICODE}
  if Encoding <> nil then
  begin
    if Encoding is TMBCSEncoding then
      XmlEncoding := seAnsi
    else
    if Encoding is TUTF8Encoding then
      XmlEncoding := seUTF8
    else
    if Encoding is TUnicodeEncoding then
      XmlEncoding := seUTF16;
  end;
  {$ENDIF UNICODE}
  FXML.SaveToFile(FileName, XmlEncoding);
end;

procedure TJvDBGridXMLExport.DoClose;
begin
  // do nothing
end;

//============================================================================

type
  TGridValue = packed record
    Value: Integer;
    Name: PChar;
  end;

const
  GridFormats: array [$10..$17] of TGridValue =
   ((Value: $10; Name: 'wdTableFormatGrid1'),
    (Value: $11; Name: 'wdTableFormatGrid2'),
    (Value: $12; Name: 'wdTableFormatGrid3'),
    (Value: $13; Name: 'wdTableFormatGrid4'),
    (Value: $14; Name: 'wdTableFormatGrid5'),
    (Value: $15; Name: 'wdTableFormatGrid6'),
    (Value: $16; Name: 'wdTableFormatGrid7'),
    (Value: $17; Name: 'wdTableFormatGrid8'));

function WordGridFormatIdentToInt(const Ident: string; var Value: Longint): Boolean;
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    if SameText(GridFormats[I].Name, Ident) then
    begin
      Result := True;
      Value := GridFormats[I].Value;
      Exit;
    end;
  Result := False;
end;

function IntToWordGridFormatIdent(Value: Longint; var Ident: string): Boolean;
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    if GridFormats[I].Value = Value then
    begin
      Result := True;
      Ident := GridFormats[I].Name;
      Exit;
    end;
  Result := False;
end;

procedure GetWordGridFormatValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    Proc(GridFormats[I].Name);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  RegisterIntegerConsts(TypeInfo(TJvWordGridFormat), WordGridFormatIdentToInt, IntToWordGridFormatIdent);

{$IFDEF UNITVERSIONING}
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.
