qexport4.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4;

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

{$I VerCtrl.inc}

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

interface

uses Classes, DB, QExport4Types, QExport4CustomSource,
     QExport4EmsWideStrUtils, QExport4IniFiles
     {$IFDEF VCL10}
       , WideStrings
     {$ELSE}
       , QExport4EmsWideStrings
     {$ENDIF}
     {$IFNDEF NOGUI}
       {$IFDEF WIN32}, Graphics, ComCtrls, DbGrids, Grids, ClipBrd{$ENDIF}
       {$IFDEF LINUX}, QGraphics, QComCtrls, QDBGrids, QGrids, QForms, QClipBrd{$ENDIF}
     {$ELSE}, QExport4Graphics{$ENDIF};

type
  TQExportRow = class;
  TQExport4 = class;

  TNormalFunc = function(const Str: QEString): QEString 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);

  {$IFDEF QE_UNICODE}
  TQExportCharsetType =
      (ectLocalANSI, ectLocalOEM, ectLocalMAC,
      ectArmscii8, ectAscii, ectCp850, ectCp852, ectCp866, ectCp1250,
      ectCp1251, ectCp1256, ectCp1257, ectDec8, ectGeostd8, ectGreek,
      ectHebrew, ectHp8, ectKeybcs2, ectKoi8r, ectKoi8u, ectLatin1,
      ectLatin2, ectLatin5, ectLatin7, ectMacce, ectMacroman, ectSwe7,
      ectUTF8, ectUTF16, ectUTF32);
  {$ENDIF}

{  TQExportCodePage = (cpLocalANSI, cpLocalOEM, cpLocalMAC, cpUTF8, cpUTF16, cpUTF32,
    cpIBM037, cpIBM437, cpIBM500, cpASMO708, cpASMO449, cpTransparentArabic,
    cpDOS720, cpIBM737, cpIBM775, cpIBM850, cpIBM852, cpIBM855, cpIBM857,
    cpIBM00858, cpIBM860, cpIBM861, cpDOS862, cpIBM863, cpIBM864,
    cpIBM865, cp866, cpIBM869, cpIBM870, cpWindows874, cp875, cpShiftJIS,
    cpGB2312, cpKSc56011987, cpBig5, cpIBM1026, cpIBM01047, cpIBM01140,
    cpIBM01141, cpIBM01142, cpIBM01143, cpIBM01144, cpIBM01145, cpIBM01146,
    cpIBM01147, cpIBM01148, cpIBM01149, cpUnicodeFFFE, cpWindows1250,
    cpWindows1251, cpWindows1252, cpWindows1253, cpWindows1254, cpWindows1255,
    cpWindows1256, cpWindows1257, cpWindows1258, cpJohab, cpMacintosh,
    cpXMACJapanese, cpXMACChinesetrad, cpXMACKorean, cpXMACArabic, cpXMACHebrew,
    cpXMACGreek, cpXMACCyrillic, cpXMACChinesesimp, cpXMACRomanian,
    cpXMACUkrainian, cpXMACThai, cpXMACCe, cpXMACIcelandic, cpXMACTurkish,
    CPXMACCroatian, cpUTF32BE, cpXChineseCNS, cpXCP20001, cpXChineseEten,
    cpXCP20003, cpXCP20004, cpXCP20005, cpXIA5, cpXIA5German, cpXIA5Swedish,
    cpXIA5Norwegian, cpUSASCII, cpXCP20261, cpXCP20269, cpIBM273,
    cpIBM277, cpIBM278, cpIBM280, cpIBM284, cpIBM285, cpIBM290, cpIBM297,
    cpIBM420, cpIBM423, cpIBM424, cpXEBCDICKoreanExtended, cpIBMThai,
    cpKOI8R, cpIBM871, cpIBM880, cpIBM905, cpIBM00924, cpEUCJP02081990and01211990,
    cpXCP20936, cpXCP20949, cp1025, cpKOI8U, cpISO88591, cpISO88592, cpISO88593,
    cpISO88594, cpISO88595, cpISO88596, cpISO88597, cpISO88598, cpISO88599,
    cpISO885913, cpISO885915, cpXEuropa, cpISO88598I, cpISO2022JP, cpCSISO2022JP,
    cpISO2022JP1bytekana, cpISO2022KR, cpXCP50227, cpISO2022TraditionalChinese,
    cpEBCDICJapaneseKatakanaExtended, cpEBCDICUSCanadaandJapanese,
    cpEBCDICKoreanExtendedandKorean,
    cpEBCDICSimplifiedChineseExtendedandSimplifiedChinese,
    cpEBCDICSimplifiedChinese, cpEBCDICUSCanadaandTraditionalChinese,
    cpEBCDICJapaneseLatinExtendedandJapanese, cpEUCJP, cpEUCCN, cpEUCKR,
    cpEUCTraditionalChinese, cpHZGB2312, //UNDER WXP ONLY!!! cpGB18030,
    cpXISCIIDE, cpXISCIIBE, cpXISCIITA, cpXISCIITE, cpXISCIIAS, cpXISCIIOR,
    cpXISCIIKA, cpXISCIIMA, cpXISCIIGU, cpXISCIIPA, cpUTF7, cpNone);}

  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: QEString; 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;
  TOnCustomFormat = procedure(Sender: TObject; Field: TField;
    var Value: QEString) 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
    FDecimalSeparator: char;
    FThousandSeparator: char;
    FDateSeparator: char;
    FTimeSeparator: char;
    FIntegerFormat: string;
    FFloatFormat : string;
    FDateFormat: string;
    FTimeFormat: string;
    FDateTimeFormat: string;
    FCurrencyFormat: string;
    FBooleanTrue: QEString;
    FBooleanFalse: QEString;
    FNullString: QEString;

    FOldDecimalSeparator: char;
    FOldThousandSeparator: char;
    FOldDateSeparator: char;
    FOldTimeSeparator: char;
    FKeepOriginalFormat: Boolean;

    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: QEString);
    procedure SetBooleanFalse(const Value: QEString);

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

    //Separator stored functions
    function IsDecimalSeparator: boolean;
    function IsThousandSeparator: boolean;
    function IsDateSeparator: boolean;
    function IsTimeSeparator: boolean;

    procedure SetNullString(const Value: QEString);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure ResetFormats;
    procedure StoreSeparators;
    procedure RestoreSeparators;
    procedure ApplyParams;
    property KeepOriginalFormat: Boolean read FKeepOriginalFormat write
      FKeepOriginalFormat;
  published
    property DecimalSeparator: char read FDecimalSeparator
      write FDecimalSeparator stored IsDecimalSeparator;
    property ThousandSeparator: char read FThousandSeparator
      write FThousandSeparator stored IsThousandSeparator;
    property DateSeparator: char read FDateSeparator write FDateSeparator
      stored IsDateSeparator;
    property TimeSeparator: char read FTimeSeparator write FTimeSeparator
      stored IsTimeSeparator;
    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: QEString read FBooleanTrue
      write SetBooleanTrue  stored IsBooleanTrueStored;
    property BooleanFalse: QEString read FBooleanFalse
      write SetBooleanFalse stored IsBooleanFalseStored;
    property NullString: QEString read FNullString write SetNullString;
  end;

  TQExportColumns = class;

  TQExportColumn = class(TCollectionItem)
  private
    FColumns: TQExportColumns;
    FNumber: integer;
    FColType: TQExportColType;
    {mp - Here is non-Unicode caption}
    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: TqeCustomSource4;
    {$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 GetColumnData(Index: integer): Variant;
    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;
  {$IFDEF QE_UNICODE}
  protected
    procedure WriteUsingCharset(WS: WideString); virtual;
  {$ENDIF}
  protected
    property Owner: TComponent read FOwner;
  public
    constructor Create(AOwner: TQExport4; AStream: TStream); virtual;

    procedure Write(const S: QEString);
    procedure WriteLn(const S: QEString);
    {$IFDEF QE_UNICODE}
    procedure WriteSignature;
    {$ENDIF}
    procedure EmptyLine;
    procedure CharLine(Chr: QEChar; Count: integer);
    function PadL(const S: QEString;
      Chr: QEChar; Count: integer): QEString;
    function PadR(const S: QEString;
      Chr: QEChar; Count: integer): QEString;
    function PadC(const S: QEString;
      Chr: QEChar; Count: integer): QEString;
    function AlignToStr(Value: TQExportColAlign): QEString; virtual;

    property Stream: TStream read FStream write FStream;
  end;

  TQExportCol = class;

  TQExportWriterClass = class of TQExportWriter;

  TQExportCol = class
  private
    FName: string;
    FValue: QEString;
    FColumnIndex: integer;
    FRow: TQExportRow;
    FData: Variant;
  public
    constructor Create(Row: TQExportRow);
    property Row: TQExportRow read FRow;
    property ColumnIndex: integer read FColumnIndex;
    property Name: string read FName;
    property Value: QEString read FValue write FValue;
    property Data: Variant read FData write FData;
  end;

  TQExportRow = class(TList)
  private
    FIndex: TStringList;
    FColumns: TQExportColumns;
    FFormats: TQExportFormats;
    function Get(Index: Integer): TQExportCol;
    procedure Put(Index: Integer; const Value: TQExportCol);
  public
    constructor Create(Columns: TQExportColumns; Formats: TQExportFormats);
    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: QEString; AData: Variant);
    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 Items[Index: Integer]: TQExportCol read Get write Put; default;
  end;

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

    FExportSource: TQExportSource;

    FDataSet: TDataSet;
    FCustomSource: TqeCustomSource4;
    {$IFNDEF NOGUI}
    FDBGrid: TDBGrid;