tmsxlsadapter.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

unit tmsXLSAdapter;
{$INCLUDE ..\FLXCOMPILER.INC}
{$INCLUDE ..\FLXCONFIG.INC}

//Note: Excel uses 1-Based arrays, and that's the interface we present to our users.
// but, TExcelWorkbook uses 0-Based arrays, to be consistent with the file format (made in C)
//So here we have to add and substract 1 everywere to be consistent.

interface
uses
  SysUtils, Classes,
  tmsUExcelAdapter, tmsXlsBaseTemplateStore, tmsUFlxMessages, tmsUExcelRecords, tmsXlsMessages,
  tmsUFlxRowComments, tmsUOle2Impl,
  {$IFDEF FLX_VCL}Clipbrd,{$ENDIF}
  {$IFDEF FLX_CLX}QClipbrd, {$ENDIF}
  Windows,
  

  {$IFDEF FLX_NEEDSVARIANTS}variants,{$ENDIF} //Delphi 6 or above
  {$IFDEF FLX_NEEDSTYPES}Types,{$ENDIF}
  tmsUXlsSheet, tmsUFlxFormats, tmsUXlsRowColEntries,
  
  tmsUXlsXF;


  {$RESOURCE tmsEmptySheet.res}

type
  TExcelSaveFormatNative= (
    snXLS, snCSVComma, snCSVSemiColon, snTabDelimited
    );

  TSetOfExcelSaveFormatNative = Set Of TExcelSaveFormatNative;


type
  TXLSAdapter = class(TExcelAdapter)
  private
    FTemplateStore: TXlsBaseTemplateStore;
    FSaveFormat: TSetOfExcelSaveFormatNative;
    FAllowOverwritingFiles: boolean;
    procedure SetTemplateStore(const Value: TXLSBaseTemplateStore);
    { Private declarations }
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    function GetWorkbook: TExcelFile;override;
    { Public declarations }
  published
    property SaveFormat: TSetOfExcelSaveFormatNative read FSaveFormat write FSaveFormat default [snXLS];
    property TemplateStore: TXLSBaseTemplateStore read FTemplateStore write SetTemplateStore;
    property AllowOverwritingFiles:boolean read FAllowOverwritingFiles write FAllowOverwritingFiles;

    { Published declarations }
  end;

  TXLSFile = class(TExcelFile)
  private
    FAdapter: TXLSAdapter;
    FActiveSheet: integer;

    FWorkbook: TWorkbook;
    FOtherStreams : ByteArray; 

    FirstColumn,LastColumn: integer;
    AllowOverwritingFiles: boolean;

    IsFileModified: boolean;

    RowPictures: TRowComments;
    procedure ParsePictures;
    procedure OpenStream(const aStream: TStream);
    procedure PasteFromBiff8(const Row, Col: integer);
    procedure PasteFromText(const Row, Col: integer);

    procedure SaveAsXls(const aFileName: string; const aStream: TStream); overload;
    procedure SaveAsXls(const aStream: TStream); overload;
    procedure SaveAsTextDelimited(const FileName: string; const DataStream: TStream; const Delim: Char);

    procedure InternalSetCellString(const aRow, aCol: integer; const Text: UTF16String; const Fm: PFlxFormat; const DateFormat, TimeFormat: UTF16String);
    procedure SetCellValueAndFmt(const aRow, aCol: integer; const v: variant; const Fm: PFlxFormat);
    function SkipThousands(const s: string): string;
    procedure RestoreObjectSizes;

  protected
    function GetActiveSheet: integer; override;
    procedure SetActiveSheet(const Value: integer); override;
    function GetActiveSheetName: UTF16String; override;
    procedure SetActiveSheetName(const Value: UTF16String); override;
    function GetActiveSheetCodeName: UTF16String; override;
    procedure SetActiveSheetCodeName(const Value: UTF16String); override;
    function GetActiveSheetVisible: TXlsSheetVisible; override;
    procedure SetActiveSheetVisible(const Value: TXlsSheetVisible); override;

    function GetColumnWidth(aCol: integer): integer;override;
    function GetColumnWidthHiddenIsZero(aCol: integer): integer;override;
    function GetRowHeight(aRow: integer): integer;override;
    function GetRowHeightHiddenIsZero(aRow: integer): integer;override;
    procedure SetColumnWidth(aCol: integer; const Value: integer);override;
    procedure SetRowHeight(aRow: integer; const Value: integer);override;

    function GetRowHidden(const aRow: integer): boolean;override;
    function GetColumnHidden(const aCol: integer): boolean;override;
    procedure SetRowHidden(const aRow: integer; const Value: boolean);override;
    procedure SetColumnHidden(const aCol: integer; const Value: boolean);override;

    function GetDefaultColWidth: integer;override;
    function GetDefaultRowHeight: integer;override;

    function GetCommentsCount(Row: integer): integer; override;
    function GetCommentText(Row, aPos: integer): UTF16String; override;
    function GetCommentColumn(Row, aPos: integer): integer; override;
    function GetPictureName(Row, aPos: integer): UTF16String;  override; //use row < 0 to return all
    function GetPicturesCount(Row: integer): integer;  override; //use row < 0 to return all

    function GetCellValue(aRow, aCol: integer): Variant; override;
    procedure SetCellValue(aRow, aCol: integer; const Value: Variant); override;
    function GetCellValueX(aRow, aCol: integer): TXlsCellValue; override;
    procedure SetCellValueX(aRow, aCol: integer; const Value: TXlsCellValue); override;

    function GetCellFormula(aRow, aCol: integer): UTF16String; override;
    procedure SetCellFormula(aRow, aCol: integer; const Value: UTF16String); override;

    function GetAutoRowHeight(Row: integer): boolean;override;
    procedure SetAutoRowHeight(Row: integer; const Value: boolean);override;

    function GetColumnFormat(aColumn: integer): integer; override;
    function GetRowFormat(aRow: integer): integer;override;
    procedure SetColumnFormat(aColumn: integer; const Value: integer);override;
    procedure SetRowFormat(aRow: integer; const Value: integer);override;

    function GetCellFormat(aRow, aCol: integer): integer; override;
    procedure SetCellFormat(aRow, aCol: integer; const Value: integer); override;

    function GetColorPalette(Index: TColorPaletteRange): LongWord; override;
    procedure SetColorPalette(Index: TColorPaletteRange; const Value: LongWord); override;

    function GetFontList(index: integer): TFlxFont; override;
    procedure SetFontList(index: integer; Value : TFlxFont); override;

    function GetFormatList(index: integer): TFlxFormat; override;
    procedure SetFormatList(index: integer; Value : TFlxFormat); override;

    function GetPageFooter: UTF16String;override;
    function GetPageHeader: UTF16String;override;
    procedure SetPageFooter(const Value: UTF16String);override;
    procedure SetPageHeader(const Value: UTF16String);override;

    function GetShowGridLines: boolean; override;
    procedure SetShowGridLines(const Value: boolean); override;
    function GetShowGridHeaders: boolean; override;
    procedure SetShowGridHeaders(const Value: boolean); override;
    function GetPrintGridLines: boolean; override;
    procedure SetPrintGridLines(const Value: boolean); override;

    function GetPrintHCentered: boolean;override;
    function GetPrintVCentered: boolean;override;
    procedure SetPrintHCentered(const Value: boolean);override;
    procedure SetPrintVCentered(const Value: boolean);override;

    function GetSheetZoom: integer;override;
    procedure SetSheetZoom(const Value: integer);override;

    function GetMargins: TXlsMargins;override;
    procedure SetMargins(const Value: TXlsMargins);override;

    function GetPrintNumberOfHorizontalPages: word;override;
    function GetPrintNumberOfVerticalPages: word;override;
    function GetPrintScale: integer;override;
    function GetPrintOptions: byte;override;
    function GetPrintToFit: boolean;override;
    procedure SetPrintNumberOfHorizontalPages(const Value: word);override;
    procedure SetPrintNumberOfVerticalPages(const Value: word);override;
    procedure SetPrintScale(const Value: integer);override;
    procedure SetPrintToFit(const Value: boolean);override;
    procedure SetPrintOptions(const Value: byte);override;

    function GetPrintCopies: integer; override;
    function GetPrinterDriverSettings: TPrinterDriverSettings; override;
    function GetPrintPaperSize: TExcelPaperSize; override;
    function GetPrintXResolution: integer; override;
    function GetPrintYResolution: integer; override;
    procedure SetPrintCopies(const Value: integer); override;
    procedure SetPrinterDriverSettings(const Value: TPrinterDriverSettings); override;
    procedure SetPrintPaperSize(const Value: TExcelPaperSize); override;
    procedure SetPrintXResolution(const Value: integer); override;
    procedure SetPrintYResolution(const Value: integer); override;


    function GetCellMergedBounds(aRow, aCol: integer): TXlsCellRange; override;
    function GetCellMergedList(index: integer): TXlsCellRange; override;

    function GetOptions1904Dates: boolean;override;
    function GetOptionsR1C1: boolean;override;
    function GetOptionsSaveExternalLinkValues: boolean;override;
    procedure SetOptions1904Dates(const Value: boolean);override;
    procedure SetOptionsR1C1(const Value: boolean);override;
    procedure SetOptionsSaveExternalLinkValues(const Value: boolean);override;
    function GetOptionsPrecisionAsDisplayed: boolean;override;
    procedure SetOptionsPrecisionAsDisplayed(const Value: boolean);override;

    function GetOutlineSummaryColsRightOfDetail: boolean; override;
    function GetOutlineSummaryRowsBelowDetail: boolean; override;
    function GetOutlineAutomaticStyles: boolean;override;
    procedure SetOutlineSummaryColsRightOfDetail(const Value: boolean); override;
    procedure SetOutlineSummaryRowsBelowDetail(const Value: boolean); override;
    procedure SetOutlineAutomaticStyles(const Value: boolean);override;

    function GetInvalidateFormulas: boolean; override;
    procedure SetInvalidateFormulas(const Value: boolean); override;

    function GetIsXltTemplate: boolean; override;
    procedure SetIsXltTemplate(const Value: boolean); override;


  public
    constructor Create(const aAdapter: TXLSAdapter);overload;
    constructor Create(const aAdapter: TXLSAdapter; const aAllowOverwritingFiles: boolean);overload;
    destructor Destroy; override;

    procedure Connect;override;
    procedure Disconnect;override;

    function GetTWorkbook: TWorkbook;

    procedure NewFile(const SheetCount: integer=3);override;
    procedure OpenFile(const FileName: TFileName);override;
    procedure OpenFileAndSearch(const FileName: TFileName);override;
    procedure OpenFileAndOrSearch(const FileName: TFileName; const Search: boolean);
    procedure LoadFromStream(const aStream: TStream);override;
    procedure CloseFile; override;

    procedure InsertAndCopySheets (const CopyFrom, InsertBefore, SheetCount: integer);override;
    procedure ClearSheet;override;
    procedure DeleteSheet(aSheetCount: integer);override;
    function SheetCount: integer;override;
    procedure SelectSheet(const SheetNo:integer); override;

    procedure DeleteMarkedRows(const Mark: UTF16String);override;
    procedure RefreshChartRanges(const VarStr: UTF16String);override;
    procedure MakePageBreaks(const Mark: UTF16String);override;
    procedure InsertHPageBreak(const Row: integer); override;
    procedure InsertVPageBreak(const Col: integer); override;
    procedure DeleteHPageBreak(const Row: integer); override;
    procedure DeleteVPageBreak(const Col: integer); override;
    function HasHPageBreak(const Row: integer): boolean;override;
    function HasVPageBreak(const Col: integer): boolean;override;
    procedure RefreshPivotTables;override;

    procedure Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent; const OnGetOutStream: TOnGetOutStreamEvent=nil; const DataStream: TStream=nil);override;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const OnlyFormulas: boolean);override;
    procedure InsertAndCopyCols(const FirstCol, LastCol, DestCol, aCount: integer; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: integer);override;
    procedure DeleteCols(const aCol, aCount: integer);override;

    procedure BeginSheet;override;
    procedure EndSheet(const RowOffset: integer);override;

    function CanOptimizeRead: boolean; override;


    function GetExcelNameCount: integer;  override;
    function GetRangeName(index: integer): UTF16String;  override;
    function GetRangeR1(index: integer): integer; override;
    function GetRangeR2(index: integer): integer; override;
    function GetRangeC1(index: integer): integer; override;
    function GetRangeC2(index: integer): integer; override;

    procedure SetRangeR1(index: integer; value: integer); override;
    procedure SetRangeR2(index: integer; value: integer); override;
    procedure SetRangeC1(index: integer; value: integer); override;
    procedure SetRangeC2(index: integer; value: integer); override;

    function GetRangeSheet(index: integer): integer; override;

    procedure AddRange(var NamedRange: TXlsNamedRange);override;

    procedure AssignPicture(const Row, aPos: integer; const Pic: ByteArray; const PicType: TXlsImgTypes); overload; override; //use row < 0 to return all
    procedure AssignPicture(const Row, aPos: integer; const Pic: ByteArray; const PicType: TXlsImgTypes; const Props: TImageProperties; const Anchor: TFlxAnchorType=at_MoveAndDontResize);overload; override;
    procedure AssignPictureProperties(const Row, aPos: integer; const Props: TImageProperties; const Anchor: TFlxAnchorType=at_MoveAndDontResize);override;
    procedure GetPicture(const Row, aPos: integer; const Pic: TStream; out PicType: TXlsImgTypes; out Anchor: TClientAnchor); override; //use row < 0 to return all

    procedure DeleteImage(const Index: integer);override;
    procedure ClearImage(const Index: integer);override;
    procedure AddImage(const Data: ByteArray; const DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType);override;

    procedure AssignComment(const Row, aPos: integer; const Comment: UTF16String); override;
    function GetCellComment(Row, Col: integer): UTF16String; override;
    procedure SetCellComment(Row, Col: integer; const Value: UTF16String; const Properties: TImageProperties); override;

    function CellMergedListCount: integer; override;
    procedure MergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer); override;
    procedure UnMergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer); override;

    function CellCount(const aRow: integer): integer;override;
    function GetCellData(const aRow, aColOffset: integer): variant;override;
    function GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;override;
    procedure GetCellDataX2(const aRow, aColOffset: integer;out v: TXlsCellValue; out RTFRuns: TRTFRunList);override;
    procedure AssignCellData(const aRow, aColOffset: integer; const Value: variant);override;
    procedure AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);override;
    procedure AssignCellDataX2(const aRow, aColOffset: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList);override;

    procedure GetCellValueX2(aRow, aCol: integer; out v: TXlsCellValue; out RTFRuns: TRTFRunList); override;
    procedure AssignCellValueX2(aRow, aCol: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList); override;

    procedure SetCellFormulaX(aRow, aCol: integer; const Formula: UTF16String; const Value: variant); override;
    procedure SetCellString(const aRow, aCol: integer; const Text: UTF16String; const DateFormat: UTF16String=''; const TimeFormat: UTF16String='');overload;override;
    procedure SetCellString(const aRow, aCol: integer; const Text: UTF16String; const Fm: TFlxFormat; const DateFormat: UTF16String=''; const TimeFormat: UTF16String='');overload;override;
    function MaxRow: integer; override;
    function MaxCol: integer; override;
    function IsEmptyRow(const aRow: integer): boolean; override;

    function ColByIndex(const Row, ColIndex: integer): integer;override;
    function ColIndexCount(const Row: integer): integer; override;
    function ColIndex(const Row, Col: integer): integer;override;

    procedure SetBounds(const aRangePos: integer);override;
    function GetFirstColumn: integer; override;

    procedure PrepareBlockData(const R1,C1,R2,C2: integer);override;
    procedure AssignBlockData(const Row,Col: integer; const v: variant);override;
    procedure PasteBlockData;override;

    function IsWorksheet(const index: integer): boolean; override;

    function FontListCount: integer;override;
    function FormatListCount: integer;override;
    function AddFont (const Fmt: TFlxFont): integer; override;
    function AddFormat (const Fmt: TFlxFormat): integer; override;

    procedure CopyToClipboardFormat(const Range: TXlsCellRange;
      out textString: string; const xlsStream: TStream);
    procedure CopyToClipboard; overload; override;
    procedure CopyToClipboard(const Range: TXlsCellRange);overload;override;
    procedure PasteFromClipboard(const Row, Col: integer);override;
    procedure PasteFromXlsClipboardFormat(const Row, Col: integer; const Stream: TStream);
    procedure PasteFromTextClipboardFormat(const Row, Col: integer; const Data: string);

    procedure ParseComments; override;

    function HyperLinkCount: integer; override;
    function GetHyperLink(const HyperLinkIndex:integer):THyperLink; override;
    procedure SetHyperLink(const HyperLinkIndex:integer; const value: THyperLink); override;
    function GetHyperLinkCellRange(const HyperLinkIndex: integer):TXlsCellRange; override;
    procedure SetHyperLinkCellRange(const HyperLinkIndex: integer; const CellRange:TXlsCellRange ); override;
    procedure AddHyperLink(const CellRange: TXlsCellRange; const value: THyperLink); override;
    procedure DeleteHyperLink(const HyperLinkIndex: integer); override;

    function GetRowOutlineLevel(const aRow: integer): integer; override;
    procedure SetRowOutlineLevel(const FirstRow, LastRow, Level: integer); override;
    function GetColOutlineLevel(const aCol: integer):integer; override;
    procedure SetColOutlineLevel(const FirstCol, LastCol, Level: integer); override;

    function GetUsedPaletteColors: BooleanArray; override;

    procedure FreezePanes(const Row, Col: integer);override;
    procedure GetFrozenPanes(out Row, Col: integer);override;
    procedure SplitWindow(const xOffset, yOffset: integer);override;
    procedure GetSplitWindow(out xOffset, yOffset: integer);override;

    procedure AutofitRow(const row1, row2: integer; const AutofitNotAutofittingRows: Boolean; const keepHeightAutomatic: Boolean; const adjustment: extended);override;
    procedure AutofitCol(const Col1, Col2: integer; const IgnoreStrings: Boolean; const Adjustment: extended);override;
    procedure AutofitRowsOnWorkbook(const AutofitNotAutofittingRows: Boolean; const KeepSizesAutomatic: Boolean; const Adjustment: extended);override;

    procedure SetAutoFilter(const row: Int32; const col1: Int32; const col2: Int32);override;
    procedure RemoveAutoFilter();override;
    function HasAutoFilter(): Boolean;overload; override;
    function HasAutoFilter(const row: Int32; const col: Int32): Boolean;overload; override;
    function GetAutoFilterRange(): TXlsCellRange;override;


  end;

implementation
uses tmsUXlsBaseRecordLists, tmsUXlsBaseRecords, tmsUXlsNotes, tmsUXlsHyperLink,
  {$IFDEF TRIAL}Dialogs,{$ENDIF}
  tmsUXlsWorkbookGlobals;