qexport4.pas

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

    FListView: TListView;
    FStringGrid: TStringGrid;
    {$ENDIF}
    FExportedFields: TStrings;

    FTitle: string;
    FHeader: QEStrings;
    FCaptions: TStrings;
    FAllowCaptions: boolean;
    FFooter: QEStrings;
    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;
    FOnCustomFormat: TOnCustomFormat;
    procedure SetExportedFields(const Value: TStrings);

    procedure SetCaptions(const Value: TStrings);
    procedure SetFooter(const Value: QEStrings);
    procedure SetHeader(const Value: QEStrings);
    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;
    {$IFDEF QE_UNICODE}
    FCharsetType: TQExportCharsetType;
    procedure SetCharsetType(const Value: TQExportCharsetType); virtual;
    {$ENDIF}
    
    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: QEString; virtual;
    procedure WriteDataRow; virtual;

    function GetColCaption(Index: integer): string; virtual;
    function GetColData(ColValue: QEString;
      Column: TQExportColumn): QEString; virtual;

    function GetSpecialCharacters: TSpecialCharacters; virtual;
    procedure SaveProperties(IniFile: TQIniFile); virtual;
    procedure LoadProperties(IniFile: TQIniFile); 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;
  protected
    property Title: string read FTitle write FTitle;
    property AllowCaptions: boolean read FAllowCaptions
      write FAllowCaptions default true;
    property AutoCalcColWidth: boolean read FAutoCalcColWidth
      write FAutoCalcColWidth default false;
    property ColumnsWidth: TStrings read FColumnsWidth write SetColumnsWidth;
    property ColumnsAlign: TStrings read FColumnsAlign write SetColumnsAlign;
    property ColumnsLength: TStrings read FColumnsLength write SetColumnsLength;

    property OnGetCellParams: TGetCellParamsEvent read FOnGetCellParams
      write FOnGetCellParams;
    property OnFetchedRecord: TExportedRecordEvent read FOnFetchedRecord
      write FOnFetchedRecord;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Execute; virtual;
    procedure ExportToStream(AStream: TStream);
    procedure Abort; virtual;
    function NormalString(const S: QEString): QEString; virtual;

    procedure SavePropertiesToFile(const FileName: string);
    procedure LoadPropertiesFromFile(const FileName: string);
    function GetExportedValue(Col: TQExportCol): QEString;

    property Aborted: boolean read FAborted write FAborted;

    property Header: QEStrings read FHeader write SetHeader;
    property Captions: TStrings read FCaptions write SetCaptions;
    property Footer: QEStrings read FFooter write SetFooter;
    property Formats: TQExportFormats read FFormats write SetFormats;
    property UserFormats: TStrings read FUserFormats write SetUserFormats;
    {$IFDEF QE_UNICODE}
    property CharsetType: TQExportCharsetType read FCharsetType write SetCharsetType
      default ectUTF8;
    {$ENDIF}
  published
    property ExportSource: TQExportSource read FExportSource
      write FExportSource default esDataSet;
    property DataSet: TDataSet read FDataSet write FDataSet;
    property CustomSource: TqeCustomSource4 read FCustomSource
      write FCustomSource;
    {$IFNDEF NOGUI}
    property ListView: TListView read FListView write FListView;
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
    property StringGrid: TStringGrid read FStringGrid write FStringGrid;
    {$ENDIF}
    property ExportedFields: TStrings read FExportedFields
      write SetExportedFields;

    property CurrentRecordOnly: boolean read FCurrentRecordOnly
      write FCurrentRecordOnly default false;
    property GoToFirstRecord: boolean read FGoToFirstRecord
      write FGoToFirstRecord default true;
    property ExportRecCount: integer read FExportRecCount
      write FExportRecCount default 0;
    property SkipRecCount: integer read FSkipRecCount
      write FSkipRecCount default 0;
    property OnlyVisibleFields: boolean read FOnlyVisibleFields
      write FOnlyVisibleFields default false;
    property AutoCalcStrType: boolean read FAutoCalcStrType
      write FAutoCalcStrType default false;
    property CaptionRow: integer read FCaptionRow write FCaptionRow default -1;
    property ExportEmpty: boolean read FExportEmpty
      write FExportEmpty default true;

    property About: string read FAbout write FAbout;
    property _Version: string read F_Version write F_Version;

    property OnBeginExport: TNotifyEvent read FOnBeginExport
      write FOnBeginExport;
    property OnEndExport: TNotifyEvent read FOnEndExport write FOnEndExport;
    property OnSkippedRecord: TExportedRecordEvent read FOnSkippedRecord
      write FOnSkippedRecord;
    property OnExportedRecord: TExportedRecordEvent read FOnExportedRecord
      write FOnExportedRecord;
    property OnStopExport: TQExportStopEvent read FOnStopExport
      write FOnStopExport;
    property OnGetExportText: TGetExportTextEvent read FOnGetExportText
      write FOnGetExportText;
    property OnBeforeExportRow: TBeforeExportRowEvent read FOnBeforeExportRow
      write FOnBeforeExportRow;
    property OnCustomFormat: TOnCustomFormat read FOnCustomFormat
      write FOnCustomFormat;
  end;

  TQExport4Text = class(TQExport4)
  private
    FFileName: string;
    {$IFDEF WIN32}
    FShowFile: boolean;
    FPrintFile: boolean;
    {$ENDIF}
  protected
    procedure ShowResult; virtual;
    procedure SaveProperties(IniFile: TQIniFile); override;
    procedure LoadProperties(IniFile: TQIniFile); override;
    function GetShowedFileName: string; virtual;
    function GetPrintedFileName: string; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Execute; override;
  published
    property FileName: string read FFileName write FFileName;
    {$IFDEF WIN32}
    property ShowFile: boolean read FShowFile write FShowFile default false;
    property PrintFile: boolean read FPrintFile write FPrintFile default false;
    {$ENDIF}
  end;

  TQExport4AdvancedText = class(TQExport4Text)
  protected
    procedure SaveProperties(IniFile: TQIniFile); override;
    procedure LoadProperties(IniFile: TQIniFile); override;
  published
    property Header;
    property Footer;
  end;

  TQExport4FormatTextSQL = class(TQExport4AdvancedText)
  protected
    procedure SaveProperties(IniFile: TQIniFile); override;
    procedure LoadProperties(IniFile: TQIniFile); override;
  published
    property Formats;
    property UserFormats;
  end;

  TQExport4FormatText = class(TQExport4AdvancedText)
  protected
    procedure SaveProperties(IniFile: TQIniFile); override;
    procedure LoadProperties(IniFile: TQIniFile); override;
  published
    property AllowCaptions;
    property Captions;
    property Formats;
    property UserFormats;
  end;

  TQExport4Memory = class(TQExport4)
  public
    {$IFNDEF NOGUI}
    procedure Execute; override;
    {$ENDIF}
  end;

  {$IFDEF QE_UNICODE}
  TWideClipboard = class(TClipboard)
  private
    function GetAsWideText: WideString;
    procedure SetAsWideText(const Value: WideString);
  public
    property AsWideText: WideString read GetAsWideText write SetAsWideText;
  end;
  {$ENDIF}

function DataType2QExportColType(Field: TField): TQExportColType;
function DataType2SQLType(Field: TField): string;
function QExportType2SQLType(Column: TQExportColumn): string;
function QExportColTypeAsString(ExportColType: TQExportColType): string;
function QExportSourceAsString(ExportSource: TQExportSource): string;

{$IFDEF WIN32}
function QExportLocale: TQExportLocale;
function QExportLoadStr(ID: Integer): string;
{$ENDIF}

implementation

uses SysUtils, TypInfo, QExport4Common
     {$IFDEF WIN32}
       , Windows, ShellAPI, QExport4StrIDs,
       {$IFDEF TRIAL}fuQExport4About,{$ENDIF} FileCtrl
     {$ENDIF}
     {$IFDEF LINUX}
       {$IFNDEF NOGUI}, Types, QExport4Consts {$ENDIF}
     {$ENDIF};

{$IFDEF WIN32}
var
  Locale: TQExportLocale = nil;
{$ENDIF}

{$IFDEF WIN32}
function QExportLocale: TQExportLocale;
begin
  if Locale = nil then
    Locale := TQExportLocale.Create;
  Result := Locale;
end;

function QExportLoadStr(ID: Integer): string;
begin
  Result := QExportLocale.LoadStr(ID);
end;
{$ENDIF}

function DataType2QExportColType(Field: TField): TQExportColType;
begin
  Result := ectUnknown;
  if not Assigned(Field) then Exit;
  case Field.DataType of
    ftBlob, ftMemo,
    {$IFNDEF VCL3}
    ftOraBlob, ftOraClob,
    ftWideString,
    {$ENDIF}
    ftString: Result := ectString;
    ftSmallint, ftInteger,
    ftWord, ftAutoInc: Result := ectInteger;
    {$IFNDEF VCL3}
    ftLargeInt: Result := ectBigint;
    {$ENDIF}
    ftBoolean: Result := ectBoolean;
    ftFloat,
    {$IFDEF VCL6}
    ftFMTBcd,
    {$ENDIF}
    ftBCD: Result := ectFloat;
    ftCurrency: Result := ectCurrency;
    ftDate: Result := ectDate;
    ftTime: Result := ectTime;
    {$IFDEF VCL6}
    ftTimeStamp,
    {$ENDIF}
    ftDateTime: Result := ectDateTime;
    ftGuid	: Result := ectString;
  end;
end;

function DataType2SQLType(Field: TField): string;
begin
  Result := 'UNKNOWN';
  case Field.DataType of
    ftOraBlob, ftBlob, ftMemo, ftGraphic, ftFmtMemo: Result := 'BLOB';
    {$IFNDEF VCL3} ftWideString, {$ENDIF}
    ftString: Result := Format('CHAR(%d)', [Field.Size]);
    ftSmallint, ftInteger, {$IFNDEF VCL3} ftLargeInt, {$ENDIF}
    ftWord, ftBoolean: Result := 'INTEGER';
    ftFloat, ftBCD, {$IFDEF VCL6} ftFMTBcd, {$ENDIF} ftCurrency: Result := 'DOUBLE PRECISION';
    ftDate, ftTime, ftDateTime: Result := 'DATE';
    ftOraClob: Result := 'CLOB'
  end;
end;

function QExportType2SQLType(Column: TQExportColumn): string;
begin
  case Column.ColType of
    ectInteger, ectBigint, ectBoolean: Result := 'INTEGER';
    ectFloat, ectCurrency: Result := 'DOUBLE PRECISSION';
    ectDate, ectTime, ectDateTime: Result := 'DATE';
    ectString: Result := Format('CHAR(%d)', [Column.Width]);
  end;
end;

function QExportColTypeAsString(ExportColType: TQExportColType): string;
begin
  case ExportColType of
    ectInteger, ectBigint: Result := 'Integer';
    ectFloat: Result := 'Float';
    ectCurrency: Result := 'Currency';
    ectDate: Result := 'Date';
    ectTime: Result := 'Time';
    ectDateTime: Result := 'DateTime';
    ectString: Result := 'String';
    ectBoolean: Result := 'Boolean';
    else Result := 'Unknown';
  end;
end;

function QExportSourceAsString(ExportSource: TQExportSource): string;
begin
  case ExportSource of
    esDataSet: Result := 'DataSet';
    esCustom: Result := 'CustomSource';
    esDBGrid: Result := 'DBGrid';
    esListView: Result := 'ListView';
    esStringGrid: Result := 'StringGrid';
    else Result := EmptyStr;
  end;
end;

{$IFDEF TRIAL}
{$IFDEF WIN32}
function IsIDERuning: Boolean;
begin
  Result := (FindWindow('TAppBuilder', nil) <> 0) or
            (FindWindow('TPropertyInspector', nil) <> 0) or
            (FindWindow('TAlignPalette', nil) <> 0);
end;
{$ENDIF}
{$ENDIF}

procedure CheckTrial;
begin
{$IFDEF TRIAL}
{$IFDEF WIN32}
  if not IsIDERuning then
    ShowAboutForm;
{$ENDIF}
{$ENDIF}