jvdbgridexport.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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 Renayud
Portions created by Lionel Renayud are Copyright (C) 2004 Lionel Renayud.
All Rights Reserved.

Contributor(s):

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDBGridExport.pas,v 1.29 2005/02/17 10:20:21 marquardt Exp $

unit JvDBGridExport;

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

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Classes, SysUtils, DB, DBGrids,
  JvComponent, 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;
    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;
  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 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;

  TJvDBGridWordExport = class(TJvCustomDBGridExport)
  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;

  TJvDBGridExcelExport = class(TJvCustomDBGridExport)
  private
    FExcel: OleVariant;
    FVisible: Boolean;
    FAutoFit: 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;
  end;

  TJvDBGridHTMLExport = class(TJvCustomDBGridExport)
  private
    FDocument: TStringList;
    FDocTitle: string;
    FHeader: TStringList;
    FFooter: TStringList;
    FIncludeColumnHeader: Boolean;
    function GetHeader: TStrings;
    function GetFooter: TStrings;
    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;
  published
    property FileName;
    property Caption;
    property Grid;
    property OnProgress;
    property IncludeColumnHeader: Boolean read FIncludeColumnHeader write FIncludeColumnHeader default True;
    property Header: TStrings read GetHeader write SetHeader;
    property Footer: TStrings read GetFooter write SetFooter;
    property DocTitle: string read FDocTitle write FDocTitle;
  end;

  TJvDBGridCSVExport = class(TJvCustomDBGridExport)
  private
    FDocument: TStringList;
    FDestination: TExportDestination;
    FExportSeparator: TExportSeparator;
    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
    Separator: string;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  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;
  end;

  TJvDBGridXMLExport = class(TJvCustomDBGridExport)
  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;
  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: '$RCSfile: JvDBGridExport.pas,v $';
    Revision: '$Revision: 1.29 $';
    Date: '$Date: 2005/02/17 10:20:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  ComObj, Graphics, Clipbrd,
  JclRegistry,
  JvConsts, JvResources;

//=== { 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;

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;

//=== { 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
    Exit;

  try
    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