qexport3.pas

DELPHI开发VCL

unit QExport3;

{$IFDEF WIN32}
  {$R QEResStr.res}
  {$R QEEULA.res}
{$ENDIF}

{$I VerCtrl.inc}

{$IFDEF VCL6}
  {$WARN UNIT_PLATFORM OFF}
{$ENDIF}

interface

uses Classes, DB, IniFiles, QExport3Types, QExport3CustomSource
     {$IFNDEF NOGUI}
       {$IFDEF WIN32}, Graphics, ComCtrls, DbGrids, Grids{$ENDIF}
       {$IFDEF LINUX}, QGraphics, QComCtrls, QDBGrids, QGrids, QForms{$ENDIF}
     {$ELSE}, QExport3Graphics{$ENDIF};

type
  TQExportRow = class;
  TQExport3 = class;

  TNormalFunc = function(const Str: string): string of object;
  TSpecialCharacters = set of char;
  TQExportSource = (esDataSet, esListView, esDBGrid, esStringGrid, esCustom);
  TQExportColAlign = (ecaLeft, ecaCenter, ecaRight);
  TQExportPageOrientation = (poPortrait, poLandscape);
  TQExportUnits = (unInch, unMillimeter, unDot);
  TQExportPageFormat = (pfLetter, pfLegal, pfA3, pfA4, pfA5, pfB5_JIS,
    pfUS_Std_Fanfold, pfFanfold, pfUser);

  TExportedRecordEvent = procedure(Sender: TObject; RecNo: integer) of object;
  TGetExportTextEvent = procedure(Sender: TObject; ColNo: integer;
    var Text: WideString) of object;
  TGetCellParamsEvent = procedure(Sender: TObject; RecNo, ColNo: integer;
    const Value: string; var Align: TQExportColAlign; AFont: TFont;
    var Background: TColor) of object;
  TQExportStopEvent = procedure(Sender: TObject;
    var CanContinue: boolean) of object;
  TBeforeExportRowEvent = procedure(Sender: TObject; Row: TQExportRow;
    var Accept: boolean) of object;

{$IFDEF WIN32}
  TLocalizeEvent = procedure(StringID: Integer; var ResultString: string) of object;

  TQExportLocale = class(TObject)
  private
    FDllHandle: Cardinal;
    FLoaded: Boolean;
    FOnLocalize: TLocalizeEvent;
    FIDEMode: Boolean;
  public
    constructor Create;
    function LoadStr(ID: Integer): string;
    procedure LoadDll(const Name: string);
    procedure UnloadDll;
    property OnLocalize: TLocalizeEvent read FOnLocalize write FOnLocalize;
  end;
{$ENDIF}

  TQExportFormats = class(TPersistent)
  private
    FIntegerFormat: string;
    FFloatFormat : string;
    FDateFormat: string;
    FTimeFormat: string;
    FDateTimeFormat: string;
    FCurrencyFormat: string;
    FBooleanTrue: string;
    FBooleanFalse: string;
    FNullString: string;

    procedure SetIntegerFormat(const Value: string);
    procedure SetFloatFormat(const Value: string);
    procedure SetDateFormat(const Value: string);
    procedure SetTimeFormat(const Value: string);
    procedure SetDateTimeFormat(const Value: string);
    procedure SetCurrencyFormat(const Value: string);
    procedure SetBooleanTrue(const Value: string);
    procedure SetBooleanFalse(const Value: string);

    function IsIntegerFormatStored: boolean;
    function IsFloatFormatStored: boolean;
    function IsDateFormatStored: boolean;
    function IsTimeFormatStored: boolean;
    function IsDateTimeFormatStored: boolean;
    function IsCurrencyFormatStored: boolean;
    function IsBooleanTrueStored: boolean;
    function IsBooleanFalseStored: boolean;

    procedure SetNullString(const Value: string);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure ResetFormats;
  published
    property IntegerFormat: string read FIntegerFormat
      write SetIntegerFormat stored IsIntegerFormatStored;
    property FloatFormat: string read FFloatFormat
      write SetFloatFormat stored IsFloatFormatStored;
    property DateFormat: string read FDateFormat
      write SetDateFormat stored IsDateFormatStored;
    property TimeFormat: string read FTimeFormat
      write SetTimeFormat stored IsTimeFormatStored;
    property DateTimeFormat: string read FDateTimeFormat
      write SetDateTimeFormat stored IsDateTimeFormatStored;
    property CurrencyFormat: string read FCurrencyFormat
      write SetCurrencyFormat stored IsCurrencyFormatStored;
    property BooleanTrue: string read FBooleanTrue
      write SetBooleanTrue  stored IsBooleanTrueStored;
    property BooleanFalse: string read FBooleanFalse
      write SetBooleanFalse stored IsBooleanFalseStored;
    property NullString: string read FNullString write SetNullString;
  end;

  TQExportColumns = class;

  TQExportColumn = class(TCollectionItem)
  private
    FColumns: TQExportColumns;
    FNumber: integer;
    FColType: TQExportColType;
    FName: string;
    FCaption: string;
    FWidth: integer;
    FColAlign: TQExportColAlign;
    FFormat: string;
    FSQLType: string;
    FLength: integer;
    FTag: integer;

    FAllowFormat: boolean;
    FIsNumeric: boolean;
    FIsString: boolean;
    FIsBlob: boolean;
    FIsMemo: boolean;
    FIsVisible: boolean;
    FIsExported: boolean;

    function GetIsDefaultFormat: boolean;
  public
    constructor Create(Collection: TCollection); override;
    procedure SetDefaultFormat;
    function GetDefaultFormat: string;

    property Columns: TQExportColumns read FColumns;

    property Number: integer read FNumber write FNumber;
    property Name: string read FName write FName;
    property Caption: string read FCaption write FCaption;
    property Width: integer read FWidth write FWidth;
    property ColType: TQExportColType read FColType write FColType;
    property ColAlign: TQExportColAlign read FColAlign write FColAlign;
    property Format: string read FFormat write FFormat;
    property SQLType: string read FSQLType write FSQLType;
    property Length: integer read FLength write FLength;
    property Tag: integer read FTag write FTag;

    property AllowFormat: boolean read FAllowFormat;
    property IsNumeric: boolean read FIsNumeric;
    property IsString: boolean read FIsString;
    property IsBlob: boolean read FIsBlob;
    property IsMemo: boolean read FIsMemo;
    property IsVisible: boolean read FIsVisible;
    property IsDefaultFormat: boolean read GetIsDefaultFormat;

    property IsExported: boolean read FIsExported write FIsExported;
  end;

  TQExportColumns = class(TCollection)
  private
    FHolder: TPersistent;
    FNormalFunc: TNormalFunc;
    FRecordCounter: integer;

    FOwnerExportedFields: TStrings;
    FOwnerExportSource: TQExportSource;
    FOwnerDataSet: TDataSet;
    FOwnerCustomSource: TqeCustomSource;
    {$IFNDEF NOGUI}
    FOwnerListView: TListView;
    FOwnerDBGrid: TDBGrid;
    FOwnerStringGrid: TStringGrid;
    {$ENDIF}
    FOwnerOnlyVisibleFields: boolean;
    FOwnerFormats: TQExportFormats;
    FOwnerAutoCalcStrType: boolean;
    FOwnerUserFormats: TStrings;
    FOwnerColumnsWidth: TStrings;
    FOwnerCaptions: TStrings;
    FOwnerColumnsAlign: TStrings;
    FOwnerSkipRecCount: integer;
    FOwnerExportRecCount: integer;
    FOwnerColumnsLength: TStrings;
    FOwnerCaptionRow: integer;

    FOwnerOnFetchedRecord: TExportedRecordEvent;

    function GetColumn(Index: integer): TQExportColumn;
    procedure SetColumn(Index: integer; Value: TQExportColumn);

    procedure LoadOwnerProperties;

    function SetColumnNumber(Index: integer; BLOB: boolean): integer;
    procedure SetColumnName(Index: integer);
    procedure SetColumnType(Index: integer);
    procedure SetColumnFormat(Index: integer);
    procedure SetColumnWidth(Index: integer);
    procedure SetColumnCaption(Index: integer);
    procedure SetColumnAlign(Index: integer);
    procedure SetColumnLength(Index: integer);
    procedure SetColumnSQLType(Index: integer);

    procedure SetColumnAllowFormat(Index: integer);
    procedure SetColumnIsNumeric(Index: integer);
    procedure SetColumnIsString(Index: integer);
    procedure SetColumnIsBlob(Index: integer);
    procedure SetColumnIsMemo(Index: integer);
    procedure SetColumnIsVisible(Index: integer);
  public
    constructor Create(Holder: TPersistent; NormalFunc: TNormalFunc);

    function Add: TQExportColumn;
    procedure Fill(BLOB: boolean);
    procedure AutoCalcColWidth;
    function IndexOfName(const AName: string): integer;
    procedure EmptyTags;
    function GetColumnIsNull(Index: integer): boolean;
    function ContainsBLOB: boolean;
    function ContainsMEMO: boolean;

    property Holder: TPersistent read FHolder;
    property Items[Index: integer]: TQExportColumn read GetColumn
      write SetColumn; default;
  end;

  TQExportWriter = class
  private
    FStream: TStream;
    FOwner: TComponent;
  protected
    property Owner: TComponent read FOwner;
  public
    constructor Create(AOwner: TQExport3; AStream: TStream); virtual;

    procedure Write(const S: string);
    procedure WriteLn(const S: string);
    procedure EmptyLine;
    procedure CharLine(Chr: char; Count: integer);
    function PadL(const S: string; Chr: char; Count: integer): string;
    function PadR(const S: string; Chr: char; Count: integer): string;
    function PadC(const S: string; Chr: char; Count: integer): string;
    function AlignToStr(Value: TQExportColAlign): string; virtual;

    property Stream: TStream read FStream write FStream;
  end;

  TQExportCol = class;

  TQExportWriterClass = class of TQExportWriter;
  TQExportGetColData = function(ExportCol: TQExportCol): string of object;

  TQExportCol = class
  private
    FName: string;
    FValue: string;
    FColumnIndex: integer;
    FNeedFormat: Boolean;
    FRow: TQExportRow;
  public
    constructor Create(Row: TQExportRow);
    function GetExportedValue(ANeedFormat: boolean): string;
    property Row: TQExportRow read FRow;

    property ColumnIndex: integer read FColumnIndex;
    property Name: string read FName;
    property NeedFormat: Boolean write FNeedFormat default True;
    property Value: string read FValue write FValue;
  end;

  TQExportRow = class(TList)
  private
    FIndex: TStringList;
    FColumns: TQExportColumns;
    FFormats: TQExportFormats;
    FGetColData: TQExportGetColData;


    function Get(Index: Integer): TQExportCol;
    procedure Put(Index: Integer; const Value: TQExportCol);
  public
    constructor Create(Columns: TQExportColumns; Formats: TQExportFormats;
      GetColData: TQExportGetColData);
    destructor Destroy; override;
    function Add(const AName: string; AColumnIndex: integer): TQExportCol;
    procedure Clear; {$IFNDEF VCL3}override;{$ENDIF}
    procedure Delete(Index: integer);
    function First: TQExportCol;
    procedure Insert(Index: Integer; Item: TQExportCol);
    procedure SetValue(const AName, AValue: string; ANeedFormat: Boolean = True);
    procedure ClearValues;
    function Last: TQExportCol;
    function IndexOf(Item: TQExportCol): integer;
    function Remove(Item: TQExportCol): integer;
    function ColByName(const AName: string): TQExportCol;
    property Index: TStringList read FIndex;

    property Columns: TQExportColumns read FColumns;
    property Formats: TQExportFormats read FFormats;
    property GetColData: TQExportGetColData read FGetColData write FGetColData;
    property Items[Index: Integer]: TQExportCol read Get write Put; default;
  end;

  TQExport3 = class(TComponent)
  private
    FRecordCounter: integer;
    FColumns: TQExportColumns;
    FExportRow: TQExportRow;

    FExportSource: TQExportSource;

    FDataSet: TDataSet;
    FCustomSource: TqeCustomSource;
    {$IFNDEF NOGUI}
    FDBGrid: TDBGrid;
    FListView: TListView;
    FStringGrid: TStringGrid;
    {$ENDIF}
    FExportedFields: TStrings;

    FTitle: string;
    FHeader: TStrings;
    FCaptions: TStrings;
    FAllowCaptions: boolean;
    FFooter: TStrings;
    FFormats: TQExportFormats;
    FUserFormats: TStrings;
    FColumnsWidth: TStrings;
    FColumnsAlign: TStrings;
    FColumnsLength: TStrings;

    FCurrentRecordOnly: boolean;
    FGoToFirstRecord: boolean;
    FExportRecCount: integer;
    FSkipRecCount: integer;
    FOnlyVisibleFields: boolean;
    FAutoCalcStrType: boolean;
    FAutoCalcColWidth: boolean;
    FCaptionRow: integer;
    FExportEmpty: boolean;

    FAborted: boolean;

    F_Version: string;
    FAbout: string;

    FOnBeginExport: TNotifyEvent;
    FOnFetchedRecord: TExportedRecordEvent;
    FOnSkippedRecord: TExportedRecordEvent;
    FOnExportedRecord: TExportedRecordEvent;
    FOnStopExport: TQExportStopEvent;
    FOnGetExportText: TGetExportTextEvent;
    FOnGetCellParams: TGetCellParamsEvent;
    FOnEndExport: TNotifyEvent;
    FOnBeforeExportRow: TBeforeExportRowEvent;

    procedure SetExportedFields(const Value: TStrings);

    procedure SetCaptions(const Value: TStrings);
    procedure SetFooter(const Value: TStrings);
    procedure SetHeader(const Value: TStrings);
    procedure SetUserFormats(const Value: TStrings);
    procedure SetFormats(const Value: TQExportFormats);
    procedure SetColumnsWidth(const Value: TStrings);
    procedure SetColumnsAlign(const Value: TStrings);
    procedure SetColumnsLength(const Value: TStrings);

    procedure CheckExportSource;
  protected
    FWriter: TQExportWriter;

    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    function GetWriterClass: TQExportWriterClass; virtual;
    function GetWriter: TQExportWriter;

    procedure DisableControls;
    procedure BeginExport; virtual;
    procedure BeforeExport; virtual;
    procedure DoExport;
    procedure AfterExport; virtual;
    procedure EndExport; virtual;
    procedure EnableControls;

    procedure First;
    procedure Next;
    procedure Skip(Count: integer);
    function  EndOfFile: boolean; virtual;

    function GetBookmark: TBookmark;
    procedure GoToBookmark(Bookmark: TBookmark);
    procedure FreeBookmark(Bookmark: TBookmark);

    function IsEmpty: boolean;
    function IsActive: boolean;

    function GetCaptionRow: string; virtual;
    procedure WriteCaptionRow; virtual;
    procedure FillExportRow; virtual;
    function GetDataRow(NeedFormat: boolean): string; virtual;
    procedure WriteDataRow; virtual;

    function GetColCaption(Index: integer): string; virtual;
    function GetColData(ExportCol: TQExportCol): string; virtual;

    function GetSpecialCharacters: TSpecialCharacters; virtual;

    procedure SaveProperties(IniFile: TIniFile); virtual;
    procedure LoadProperties(IniFile: TIniFile); virtual;

    procedure GetCellParams(RecNo, ColNo: integer; const Value: string;
      var Align: TQExportColAlign; AFont: TFont;
      var Background: TColor); dynamic;
    function CanContinue: boolean;
  protected
    property RecordCounter: integer read FRecordCounter write FRecordCounter;
    property Columns: TQExportColumns read FColumns write FColumns;
    property ExportRow: TQExportRow read FExportRow;