tmsuxlsbaserecords.pas

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

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

interface
uses Sysutils, Contnrs, Classes,
    {$IFDEF FLX_NEEDSVARIANTS} variants,{$ENDIF}
     tmsXlsMessages, tmsUFlxMessages, tmsUOle2Impl;

type
  TContinueRecord=class;

  TBaseRecord = class (TObject)
  public
    Id: word;
    Data: PArrayOfByte;
    DataSize: word;

    Continue: TContinueRecord;

    procedure SaveDataToStream(const Workbook: TOle2File; const aData: PArrayOfByte);
  protected
    function DoCopyTo: TBaseRecord; virtual;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);virtual;
    destructor Destroy; override;
    procedure AddContinue(const aContinue: TContinueRecord);

    procedure SaveToStream(const Workbook: TOle2File); virtual;
    function CopyTo: TBaseRecord;  //this should be non-virtual
    function TotalSize: integer;virtual;
    function TotalSizeNoHeaders: integer;virtual;
  end;

  ClassOfTBaseRecord= Class of TBaseRecord;

  TContinueRecord=class(TBaseRecord)
  end;

  TIgnoreRecord = class (TBaseRecord)
    function TotalSize: integer; override;
    procedure SaveToStream(const Workbook: TOle2File); override;
  end;

  TSubListRecord = class (TBaseRecord)  //This is a "virtual" record used to save sublists to stream
  private
    FSubList: TObjectList;
  protected
    function DoCopyTo: TBaseRecord; override;

  public
    constructor  CreateAndAssign(const aSubList: TObjectList);
    function TotalSize: integer; override;
    procedure SaveToStream(const Workbook: TOle2File); override;
  end;

  TBaseRowColRecord = class(TBaseRecord)
  private
    function GetColumn: word;
    function GetRow: word;
    procedure SetColumn( Value: word );
    procedure SetRow( Value: word );
  public
    property Row: word read GetRow write SetRow;
    property Column: word read GetColumn write SetColumn;

    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);virtual;
    procedure ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);virtual;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    function FixTotalSize(const NeedsRecalc: boolean): int64; virtual;
 end;

  TCellRecord=class(TBaseRowColRecord)
  private
    function GetXF: word;
    procedure SetXF(const Value: word);
  protected
    function GetValue: Variant; virtual;
    procedure SetValue(const Value: Variant); virtual;
  public
    property XF: word read GetXF write SetXF;
    property Value:Variant read GetValue write SetValue;
    constructor CreateFromData(const aId, aDataSize, aRow, aCol, aXF: word);

    function CanJoinNext(const NextRecord: TCellRecord; const MaxCol: integer): boolean;virtual;
    procedure SaveFirstMul(const Workbook: TOle2File; const JoinedRecordSize: Word);virtual;
    procedure SaveMidMul(const Workbook: TOle2File);virtual;
    procedure SaveLastMul(const Workbook: TOle2File);virtual;
    function TotalSizeFirst: integer; virtual;
    function TotalSizeMid: integer; virtual;
    function TotalSizeLast: integer;virtual;

  end;

  TRowRecord=class(TBaseRowColRecord)
  private
    function GetHeight: word;
    function GetMaxCol: word;
    function GetMinCol: word;
    function GetXF: word;
    procedure SetHeight(const Value: word);
    procedure SetMaxCol(const Value: word);
    procedure SetMinCol(const Value: word);
    procedure SetXF(const Value: word);
    function GetOptions: word;
    procedure SetOptions(const Value: word);
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    constructor CreateStandard(const Row: word);
    function GetRow: Word;

    property MaxCol: word read GetMaxCol write SetMaxCol;
    property MinCol: word read GetMinCol write SetMinCol;
    property Height: word read GetHeight write SetHeight;
    property XF: word read GetXF write SetXF;
    function IsFormatted: boolean;
    function IsModified: boolean;
    property Options: word read GetOptions write SetOptions;

    procedure ManualHeight;
    procedure AutoHeight;
    procedure Hide(const value: boolean);
    function IsAutoHeight: boolean;
    function IsHidden: boolean;
    procedure SaveRangeToStream(const DataStream: TOle2File; const aMinCol, aMaxCol: integer);

    procedure SetRowOutlineLevel(const Level: integer);
  end;

  TDimensionsRec=packed record
    FirstRow, LastRow: LongWord;
    FirstCol, LastCol: Word;
    Extra: word;
  end;
  PDimensionsRec=^TDimensionsRec;
  
  TDimensionsRecord=class(TBaseRecord)
    function Dim: PDimensionsRec;
  end;

  TStringRecord=class(TBaseRecord)
  public
    procedure SaveToStream(const Workbook: TOle2File); override;
    function TotalSize: integer; override;
    function Value: UTF16String;
  end;

  TWindow1Record=class(TBaseRecord)
  private
    function GetActiveSheet: integer;
    procedure SetActiveSheet(const Value: integer);
    function GetFirstSheetVisible: integer;
    procedure SetFirstSheetVisible(const Value: integer);
  public
    property ActiveSheet: integer read GetActiveSheet write SetActiveSheet;
    property FirstSheetVisible: integer read GetFirstSheetVisible write SetFirstSheetVisible;
  end;

  TWindow2Record=class(TBaseRecord)
  private
    function GetSelected: boolean;
    procedure SetSelected(const Value: boolean);
    function GetShowGridLines: boolean;
    procedure SetShowGridLines(const Value: boolean);
    function GetShowGridHeaders: boolean;
    procedure SetShowGridHeaders(const Value: boolean);
    procedure SetSheetZoom(const Value: integer);
    function GetSheetZoom: integer;
    function GetIsFrozen: Boolean;
    function GetIsFrozenButNoSplit: Boolean;
    procedure SetIsFrozen(const value: Boolean);
    procedure SetIsFrozenButNoSplit(const value: Boolean);
  protected
    function DoCopyTo: TBaseRecord; override;
  public
    property Selected: boolean read GetSelected write SetSelected;
    property ShowGridLines: boolean read GetShowGridLines write SetShowGridLines;
    property ShowGridHeaders: boolean read GetShowGridHeaders write SetShowGridHeaders;
    property SheetZoom: integer read GetSheetZoom write SetSheetZoom;

    property IsFrozen: Boolean read GetIsFrozen write SetIsFrozen;
    property IsFrozenButNoSplit: Boolean read GetIsFrozenButNoSplit write SetIsFrozenButNoSplit;

  end;

  TSCLRecord=class(TBaseRecord)
  private
    function GetZoom: integer;
    procedure SetZoom(const Value: integer);
  public
    constructor CreateFromData(const aZoom: integer);
    property Zoom: integer read GetZoom write SetZoom;
  end;

  TDefColWidthRecord = class(TBaseRecord)
  public
    function Width: Word;
  end;

  TStandardWidthRecord = class(TBaseRecord)
  public
    function Width: Word;
  end;

  TDefRowHeightRecord = class(TBaseRecord)
  public
    function Height: Word;
  end;

  TPageHeaderFooterRecord = class(TBaseRecord)
  private
    function GetText: UTF16String;
    procedure SetText(const Value: UTF16String);
  public
    property Text: UTF16String read GetText write SetText;
  end;

  TPageHeaderRecord = class(TPageHeaderFooterRecord)
  end;

  TPageFooterRecord = class(TPageHeaderFooterRecord)
  end;

  TPrintGridLinesRecord = class(TBaseRecord)
  private
    function GetValue: boolean;
    procedure SetValue(const Value: boolean);
  public
    property Value: boolean read GetValue write SetValue;
  end;


  TMarginRecord=class(TBaseRecord)
  private
    function GetValue: double;
    procedure SetValue(const Value: double);
  public
    property Value: double read GetValue write SetValue;
  end;

  TSetupRec=packed record
    PaperSize: word;
    Scale: word;
    PageStart: word;
    FitWidth: word;
    FitHeight: word;
    GrBit: word;
    Resolution: word;
    VResolution: word;
    HeaderMargin: double;
    FooterMargin: double;
    Copies: word;
  end;
  PSetupRec=^TSetupRec;

  TSetupRecord=class(TBaseRecord)
  private
    function GetValue: TSetupRec;
    procedure SetValue(const Value: TSetupRec);
    function GetScale: word;
    procedure SetScale(const Value: word);
    function GetFitHeight: word;
    function GetFitWidth: word;
    procedure SetFitHeight(const Value: word);
    procedure SetFitWidth(const Value: word);
    function GetFooterMargin: extended;
    function GetHeaderMargin: extended;
    procedure SetFooterMargin(const Value: extended);
    procedure SetHeaderMargin(const Value: extended);
    function GetPrintOptions: word;
    procedure SetPrintOptions(const Value: word);
    function GetPrintCopies: integer;
    function GetPrintPaperSize: TExcelPaperSize;
    function GetPrintXResolution: integer;
    function GetPrintYResolution: integer;
    procedure SetPrintCopies(const Value: integer);
    procedure SetPrintPaperSize(const Value: TExcelPaperSize);
    procedure SetPrintXResolution(const Value: integer);
    procedure SetPrintYResolution(const Value: integer);
  public
    property Value: TSetupRec read GetValue write SetValue;
    property Scale: word read GetScale write SetScale;
    property PrintOptions: word read GetPrintOptions write SetPrintOptions;
    property FitWidth: word read GetFitWidth write SetFitWidth;
    property FitHeight: word read GetFitHeight write SetFitHeight;

    property PrintPaperSize: TExcelPaperSize read GetPrintPaperSize write SetPrintPaperSize;
    property PrintCopies: integer read GetPrintCopies write SetPrintCopies;
    property PrintXResolution: integer read GetPrintXResolution write SetPrintXResolution;
    property PrintYResolution: integer read GetPrintYResolution write SetPrintYResolution;

    property HeaderMargin: extended read GetHeaderMargin write SetHeaderMargin;
    property FooterMargin: extended read GetFooterMargin write SetFooterMargin;
  end;

  TPlsRecord=class(TBaseRecord)
  private
    function GetPrinterDriverSettings: TPrinterDriverSettings;
    procedure SetPrinterDriverSettings(
      const Value: TPrinterDriverSettings);
  public
    constructor CreateFromData(aPrinterData: TPrinterDriverSettings);

    property PrinterData: TPrinterDriverSettings read GetPrinterDriverSettings write SetPrinterDriverSettings;
  end;

  TPrintCenteredRecord = class(TBaseRecord)
  private
    function GetCentered: boolean;
    procedure SetCentered(const Value: boolean);
    public
    property Centered: boolean read GetCentered write SetCentered;
  end;

  TWsBoolRecord=class(TBaseRecord)
  private
    function GetValue: word;
    procedure SetValue(const Value: word);
    function GetFitToPage: boolean;
    procedure SetFitToPage(const Value: boolean);
    function GetOutlineSummaryColsRightOfDetail: boolean;
    function GetOutlineSummaryRowsBelowDetail: boolean;
    function GetOutlineAutomaticStyles: boolean;
    procedure SetOutlineRightOfDetail(const Value: boolean);
    procedure SetOutlineSummaryRowsBelowDetail(const Value: boolean);
    procedure SetOutlineAutomaticStyles(const Value: boolean);
  public
    property Value: word read GetValue write SetValue;
    property FitToPage: boolean read GetFitToPage write SetFitToPage;
    property OutlineSummaryRowsBelowDetail: boolean read GetOutlineSummaryRowsBelowDetail write SetOutlineSummaryRowsBelowDetail;
    property OutlineSummaryColsRightOfDetail: boolean read GetOutlineSummaryColsRightOfDetail write SetOutlineRightOfDetail;
    property OutlineAutomaticStyles: boolean read GetOutlineAutomaticStyles write SetOutlineAutomaticStyles;
  end;

  T1904Record = class(TBaseRecord)
  private
    function GetIs1904: boolean;
    procedure SetIs1904(const Value: boolean);
  public
    property Is1904: boolean read GetIs1904 write SetIs1904;
  end;

  TRefModeRecord = class(TBaseRecord)
  private
    function GetIsR1C1: boolean;
    procedure SetIsR1C1(const Value: boolean);
  public
    property IsR1C1: boolean read GetIsR1C1 write SetIsR1C1;
  end;

  TPrecisionRecord = class(TBaseRecord)
  private
    function GetPrecisionAsDisplayed: boolean;
    procedure SetPrecisionAsDisplayed(const Value: boolean);
  public
    property PrecisionAsDisplayed: boolean read GetPrecisionAsDisplayed write SetPrecisionAsDisplayed;
  end;

  TBookBoolRecord = class(TBaseRecord)
  private
    function GetSaveExternalLinkValues: boolean;
    procedure SetSaveExternalLinkValues(const Value: boolean);
  public
    property SaveExternalLinkValues: boolean read GetSaveExternalLinkValues write SetSaveExternalLinkValues;
  end;

  /// <summary>
  /// AutoFilter Information
  /// </summary>
  TAutoFilterInfoRecord = class (TBaseRecord)
  private
    function Get_DropDownCount(): Int32;
    procedure Set_DropDownCount(const value: Int32);

  public
    property DropDownCount: Int32 read Get_DropDownCount write Set_DropDownCount;
  end;




//------------------------------------ Utility functions
  function LoadRecords(const DataStream: TOle2File; var RecordHeader: TRecordHeader): TBaseRecord;
  procedure ReadMem(var aRecord: TBaseRecord; var aPos: integer; const aSize: integer; const pResult: pointer);
  procedure ReadStr(var aRecord: TBaseRecord; var aPos: integer; var ShortData: AnsiString; var WideData: UTF16String; var OptionFlags, ActualOptionFlags: byte; var DestPos: integer; const StrLen: integer );

implementation
uses tmsUXlsFormula, tmsUXlsOtherRecords, tmsUXlsSST, tmsUXlsReferences, tmsUXlsCondFmt, tmsUXlsChart, tmsUXlsEscher,
     tmsUXlsNotes, tmsUXlsCellRecords, tmsUXlsPageBreaks, tmsUXlsStrings, tmsUXlsColInfo, tmsUXlsXF,
     tmsUXlsBaseRecordLists, tmsUXlsPalette, tmsUXlsHyperLink;

//------------------------------------ Utility functions

procedure ReadMem(var aRecord: TBaseRecord; var aPos: integer; const aSize: integer; const pResult: pointer);
//Read memory taking in count "Continue" Records
var
  l: integer;
begin
  l:= aRecord.DataSize-aPos;

  if l<0 then raise Exception.Create(ErrReadingRecord);
  if (l=0) and (aSize>0) then