qexport4xls.pas

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

    procedure Assign(Source: TPersistent); override;
  published
    property PageHeader: WideString read FPageHeader write FPageHeader;
    property PageFooter: WideString read FPageFooter write FPageFooter;
    property SheetTitle: string read FSheetTitle write SetSheetTitle;

    property HeaderFormat: TxlsFormat read FHeaderFormat
      write SetHeaderFormat;
    property CaptionsFormat: TxlsFormat read FCaptionsFormat
      write SetCaptionsFormat;
    property DataFormat: TxlsFormat read FDataFormat
      write SetDataFormat;
    property AggregateFormat: TxlsFormat read FAggregateFormat
      write SetAggregateFormat;
    property FooterFormat: TxlsFormat read FFooterFormat
      write SetFooterFormat;
    property HyperlinkFormat: TxlsFormat read FHyperlinkFormat
      write SetHyperlinkFormat;
    property NoteFormat: TxlsNoteFormat read FNoteFormat
      write SetNoteFormat;
  end;

  TQXLSWriter = class(TQExportWriter)
  private
  public
    {$IFNDEF OLE_STREAM}
    procedure StreamFinalAction;
    {$ENDIF}

  end;

  TxlsColumn = class
  private
    FName: string;
    FCol1: integer;
    FRow1: integer;
    FCol2: integer;
    FRow2: integer;
  public
    constructor Create(const Name: string);
    property Name: string read Fname write FName;
    property Col1: integer read FCol1 write FCol1;
    property Row1: integer read FRow1 write FRow1;
    property Col2: integer read FCol2 write FCol2;
    property Row2: integer read FRow2 write FRow2;
  end;

  TxlsColumnList = class(TList)
  private
    function Get(Index: integer): TxlsColumn;
    procedure Put(Index: integer; Value: TxlsColumn);
  public
    function Add(Item: TxlsColumn): integer;
    procedure Delete(Index: integer);
    procedure CheckCell(const ColName: string; Row, Col: integer);
    function IndexOf(const ColName: string): integer;
    procedure AssignColumnToDataRange(const ColName: string; DataRange: TxlsDataRange);

    property Items[Index: integer]: TxlsColumn read Get write Put; default;
  end;

  TxlsStripType = (ssNone, ssCol, ssRow);

  TxlsExportStage = (esNone, esHeader, esCaption, esData, esAggregate, esFooter);

  TxlsExportedRecordEvent = procedure(Sender: TObject; Sheet,
    RecNo: integer) of object;
  TxlsGetExportTextEvent = procedure(Sender: TObject; Sheet, ColNo: integer;
    var Text: WideString) of object;
  TxlsBeforeExportRowEvent = procedure(Sender: TObject; Sheet: integer;
    Row: TQExportRow; var Accept: boolean) of object;
  TGetHeaderFooterParamsEvent = procedure(Sender: TObject; Sheet, Col,
    Row: integer; Format: TxlsFormat; var S: WideString) of object;
  TGetCaptionParamsEvent = procedure(Sender: TObject; Sheet, Col: integer;
    Format: TxlsFormat; var Caption: string) of object;
  TGetDataParamsEvent = procedure(Sender: TObject; Sheet, Col, Row: integer;
    Format: TxlsFormat; var FormatText: string) of object;
  TGetAggregateParamsEvent = procedure(Sender: TObject; Sheet, Col: integer;
    Format: TxlsFormat; var FormatText, Value: string) of object;
  TxlsExportSheetEvent = procedure(Sender: TObject;
    SheetIndex: integer) of object;


  TxlsSheetEvent = procedure(Sheet: TxlsSheet) of object;

  TXlsSubAggregates = class;

  TxlsSheet = class(TCollectionItem)
  private
    FQExportXLS: TQExport4XLS;
    FColumns: TQExportColumns;
    FExportRow: TQExportRow;
    FCurrentRow: integer;
    FRecordCounter: integer;
    FTotalCols: integer;
    FNeedCheckRowHeight: boolean;

    FAutoCalcColWidth: boolean;
    FTitle: WideString;
    FOptions: TXLSOptions;
    FFieldFormats: TxlsFieldFormats;
    FStripStyles: TxlsFormats;
    FStripType: TxlsStripType;
    FExportSource: TQExportSource;
    FDataSet: TDataSet;
    FCustomSource: TqeCustomSource4;
    {$IFNDEF NOGUI}
    FListView: TListView;
    FDBGrid: TDBGrid;
    FStringGrid: TStringGrid;
    {$ENDIF}
    FExportedFields: TStrings;
    FHeaderRows: word;
    FStartDataCol: byte;
    FFooterRows: word;
    FHeader: {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStrings{$ENDIF};
    FCaptions: TStrings;
    FFooter: {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStrings{$ENDIF};
    FFormats: TQExportFormats;
    FUserFormats: TStrings;
    FColumnsWidth: TStrings;
    FHyperlinks: TxlsHyperlinks;
    FNotes: TxlsNotes;
    FCharts: TxlsCharts;
    FImages: TxlsImages;
    FCells: TxlsCells;
    FMergedCells: TxlsMergedCellList;
    FBackground: TxlsGraphic;

    FDefRowHeight: double;
    FDefColWidth: integer;

    FAllowCaptions: boolean;
    FGoToFirstRecord: boolean;
    FExportRecCount: integer;
    FSkipRecCount: integer;
    FCurrentRecordOnly: boolean;
    FOnlyVisibleFields: boolean;
    FAutoCalcStrType: boolean;
    FCaptionRow: integer;
    FExported: boolean;
    FTag: integer;

    FColumnList: TxlsColumnList;

    FSubAggControlColumn: string;
    FPreviousColumnValue: string;
		FSubAggregates: TXlsSubAggregates;
		FSubAggStartRow: Word;

    function GetStartDataRow: word;
    function GetWriter: TQXLSWriter;

    function IsTitle: boolean;
    procedure SetOptions(const Value: TXLSOptions);
    procedure SetFieldFormats(const Value: TxlsFieldFormats);
    procedure SetStripStyles(const Value: TxlsFormats);
    procedure SetExportedFields(const Value: TStrings);
    procedure SetHeader(const Value: {$IFDEF QE_UNICODE}TWideStringList
      {$ELSE}TStrings{$ENDIF});
    procedure SetCaptions(const Value: TStrings);
    procedure SetFooter(const Value: {$IFDEF QE_UNICODE}TWideStringList
      {$ELSE}TStrings{$ENDIF});
    procedure SetFormats(const Value: TQExportFormats);
    procedure SetUserFormats(const Value: TStrings);
    procedure SetColumnsWidth(const Value: TStrings);
    procedure SetHyperlinks(const Value: TxlsHyperlinks);
    procedure SetNotes(const Value: TxlsNotes);
    procedure SetCharts(const Value: TxlsCharts);
    procedure SetImages(const Value: TxlsImages);
    procedure SetCells(const Value: TxlsCells);
    procedure SetMergedCells(const Value: TxlsMergedCellList);
    procedure SetBackground(const Value: TxlsGraphic);

    function GetExportStage: TxlsExportStage;
    procedure SetExportStage(const Value: TxlsExportStage);

    function IsDefRowHeight: boolean;
    procedure SetSubAggControlColumn(const Value: string);
  protected
    function GetDisplayName: string; override;

    function AddXF(TextFormat: string; Format: TxlsFormat): word;
    function GetXF(ColIndex: integer): integer;
    procedure AddColumnToFormatList(ColIndex: integer);
    procedure AddStylesToFormatList;
    procedure HeaderFooter(HeaderFooter: {$IFDEF QE_UNICODE}TWideStringList
      {$ELSE}TStrings{$ENDIF}; Limit: word;
      Event: TGetHeaderFooterParamsEvent; Fmt: TxlsFormat);

    procedure InitExport;
    procedure DoHeader;
    procedure DoCaption;
    procedure DoBeforeData;
    procedure FillExportRow;
    procedure DoData;
    procedure DoAggregate;
    procedure DoFooter;

    property Columns: TQExportColumns read FColumns;
    property ExportRow: TQExportRow read FExportRow;
    property Writer: TQXLSWriter read GetWriter;
    property StartDataRow: word read GetStartDataRow;
    property CurrentRow: integer read FCurrentRow;
    property TotalCols: integer read FTotalCols;
    property ExportStage: TxlsExportStage read GetExportStage
      write SetExportStage;
    property RecordCounter: integer read FRecordCounter;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    procedure LoadFromQExportXLS;
    procedure SaveToQExportXLS;

    function AddBooleanCell(Col, Row: word; Value: boolean): TxlsCell;
    function AddDateTimeCell(Col, Row: word; DateTimeFormat: string;
      Value: TDateTime): TxlsCell;
    function AddNumericCell(Col, Row: word; NumericFormat: string;
      Value: double): TxlsCell;
    function AddStringCell(Col, Row: word; const Value: string): TxlsCell;
    function AddMergedCells(FirstRow, LastRow, FirstCol,
      LastCol: word): TxlsMergedCells;

    property QExportXLS: TQExport4XLS read FQExportXLS;
  published
    property AutoCalcColWidth: boolean read FAutoCalcColWidth
      write FAutoCalcColWidth default false;
    property Title: WideString read FTitle
      write FTitle stored IsTitle;
    property Options: TXLSOptions read FOptions
      write SetOptions;
    property FieldFormats: TxlsFieldFormats read FFieldFormats
      write SetFieldFormats;
    property StripStyles: TxlsFormats read FStripStyles
      write SetStripStyles;
    property StripType: TxlsStripType read FStripType
      write FStripType default ssNone;
    property Hyperlinks: TxlsHyperlinks read FHyperlinks
      write SetHyperlinks;
    property Notes: TxlsNotes read FNotes write SetNotes;
    property Charts: TxlsCharts read FCharts write SetCharts;
    property Images: TxlsImages read FImages write SetImages;
    property Cells: TxlsCells read FCells write SetCells;
    property MergedCells: TxlsMergedCellList read FMergedCells
      write SetMergedCells;
    property Background: TxlsGraphic read FBackground write SetBackground;

    property SubAggControlColumn: string read FSubAggControlColumn
      write SetSubAggControlColumn;

    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 HeaderRows: word read FHeaderRows write FHeaderRows default 0;
    property StartDataCol: byte read FStartDataCol
      write FStartDataCol default 0;
    property FooterRows: word read FFooterRows write FFooterRows default 0;

    property ExportedFields: TStrings read FExportedFields
      write SetExportedFields;

    property Header: {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStrings{$ENDIF}
      read FHeader write SetHeader;
    property Captions: TStrings read FCaptions write SetCaptions;
    property Footer: {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStrings{$ENDIF}
      read FFooter write SetFooter;
    property Formats: TQExportFormats read FFormats write SetFormats;
    property UserFormats: TStrings read FUserFormats write SetUserFormats;
    property ColumnsWidth: TStrings read FColumnsWidth write SetColumnsWidth;

    property DefRowHeight: double read FDefRowHeight
      write FDefRowHeight stored IsDefRowHeight;
    property DefColWidth: integer read FDefColWidth
      write FDefColWidth default DEF_COL_WIDTH;

    property AllowCaptions: boolean read FAllowCaptions
      write FAllowCaptions default true;
    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 CurrentRecordOnly: boolean read FCurrentRecordOnly
      write FCurrentRecordOnly default false;
    property OnlyVisibleFields: boolean read FOnlyVisibleFields
      write FOnlyVisibleFields default true;
    property AutoCalcStrType: boolean read FAutoCalcStrType
      write FAutoCalcStrType default false;
    property CaptionRow: integer read FCaptionRow
      write FCaptionRow default -1;
    property Exported: boolean read FExported
      write FExported default true;
    property Tag: integer read FTag write FTag default 0;
  end;

  TxlsSheets = class(TCollection)
  private
    FQExportXLS: TQExport4XLS;
  protected
    function GetOwner: TPersistent; override;
    function GetItem(Index: integer): TxlsSheet;
    procedure SetItem(Index: integer; Value: TxlsSheet);
  public
    constructor Create(QExportXLS: TQExport4XLS);
    function Add: TxlsSheet;

    property QExportXLS: TQExport4XLS read FQExportXLS;
    property Items[Index: integer]: TxlsSheet read GetItem
      write SetItem; default;
  end;

  TxlsBoundSheet = class
  private
    FIndex: integer;
    FTitle: WideString;
    FBOFPos: integer;
    FAddPos: integer;
    FDimensionPos: integer;
    FFirstRow: integer;
    FLastRow: integer;
    FFirstCol: integer;
    FLastCol: integer;
  public
    constructor Create;

    property Index: integer read FIndex write FIndex;
    property Title: WideString read FTitle write FTitle;
    property BOFPos: integer read FBOFPos write FBOFPos;
    property AddPos: integer read FAddPos write FAddPos;
    property FirstRow: integer read FFirstRow write FFirstRow;
    property LastRow: integer read FLastRow write FLastRow;
    property FirstCol: integer read FFirstCol write FFirstCol;
    property LastCol: integer read FLastCol write FLastCol;
    property DimensionPos: integer read FDimensionPos write FDimensionPos;
  end;

  TxlsBoundSheetList = class(TList)
  private
    function Get(Index: integer): TxlsBoundSheet;
    procedure Put(Index: integer; Value: TxlsBoundSheet);