uxlsbaserecords.pas

TMS Component Pack Pro v4.2

unit UXlsBaseRecords;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}
{$IFDEF LINUX}{$INCLUDE ../FLXCONFIG.INC}{$ELSE}{$INCLUDE ..\FLXCONFIG.INC}{$ENDIF}

interface
uses Sysutils, Contnrs, Classes,
    {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
     XlsMessages, UFlxMessages;

type
  TContinueRecord=class;

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

    Continue: TContinueRecord;

    procedure SaveDataToStream(const Workbook: TStream; 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: TStream); 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: TStream); 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: TStream); 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;
  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: TStream; const JoinedRecordSize: Word);virtual;
    procedure SaveMidMul(const Workbook: TStream);virtual;
    procedure SaveLastMul(const Workbook: TStream);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: TStream; 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: TStream); override;
    function TotalSize: integer; override;
    function Value: widestring;
  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: WideString;
    procedure SetText(const Value: WideString);
  public
    property Text: WideString 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;

  TWsBoolRecord=class(TBaseRecord)
  private
    function GetValue: word;
    procedure SetValue(const Value: word);
    function GetFitToPage: boolean;
    procedure SetFitToPage(const Value: boolean);
  public
    property Value: word read GetValue write SetValue;
    property FitToPage: boolean read GetFitToPage write SetFitToPage;
  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;


////////////////////////////// Utility functions
  function LoadRecord(const DataStream: TStream; const 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: string; var WideData: WideString; var OptionFlags, ActualOptionFlags: byte; var DestPos: integer; const StrLen: integer );

implementation
uses UXlsFormula, UXlsOtherRecords, UXlsSST, UXlsReferences, UXlsCondFmt, UXlsChart, UXlsEscher,
     UXlsNotes, UXlsCellRecords, UXlsPageBreaks, UXlsStrings, UXlsColInfo, UXlsXF,
     UXlsBaseRecordLists, UXlsPalette, UXlsHyperLink;

////////////////////////////// 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
  begin
    aPos:=0;
    aRecord:=aRecord.Continue;
    if aRecord=nil then raise Exception.Create(ErrReadingRecord);
  end;

  l:= aRecord.DataSize-aPos;

  if aSize<=l then
  begin
    if pResult<>nil then Move(aRecord.Data^[aPos], pResult^, aSize);
    inc(aPos, aSize);
  end else
  begin
    ReadMem(aRecord, aPos, l, pResult);
    if pResult<>nil then ReadMem(aRecord, aPos, aSize-l, PCHAR(pResult)+ l)
    else ReadMem(aRecord, aPos, aSize-l, nil);
  end
end;

procedure ReadStr(var aRecord: TBaseRecord; var aPos: integer; var ShortData: string; var WideData: WideString; var OptionFlags, ActualOptionFlags: byte; var DestPos: integer; const StrLen: integer );
//Read a string taking in count "Continue" Records
var
  l,i: integer;
  pResult: pointer;
  aSize, CharSize: integer;
begin
  l:= aRecord.DataSize-aPos;

  if l<0 then raise Exception.Create(ErrReadingRecord);
  if (l=0) and (StrLen>0) then
  // This is not a valid Excel thing, but if it is (f.i. on JET exported files), the optionflags will be repeated.
    {if DestPos=0 then  //we are beginning the record
    begin
      aPos:=0;
      if aRecord.Continue=nil then raise Exception.Create(ErrReadingRecord);
      aRecord:=aRecord.Continue;
    end else }
    begin       //We are in the middle of a string
      aPos:=1;
      if aRecord.Continue=nil then raise Exception.Create(ErrReadingRecord);
      aRecord:=aRecord.Continue;
      ActualOptionFlags:=aRecord.Data[0];
      if (ActualOptionFlags=1) and ((OptionFlags and 1)=0 ) then
      begin
        WideData:=StringToWideStringNoCodePage(ShortData);
        OptionFlags:= OptionFlags or 1;
      end;
    end;

  l:= aRecord.DataSize-aPos;

  if (ActualOptionFlags and 1)=0 then
  begin
    aSize:= StrLen-DestPos;
    pResult:= @ShortData[DestPos+1];
    CharSize:=1;
  end else
  begin
    aSize:= (StrLen-DestPos)*2;
    pResult:= @WideData[DestPos+1];
    CharSize:=2;
  end;

  if aSize<=l then
  begin
    if (ActualOptionFlags and 1=0) and (OptionFlags and 1=1) then
      //We have to move result to widedata
      for i:=0 to aSize div CharSize -1 do WideData[DestPos+1+i]:=WideChar(aRecord.Data^[aPos+i])
      //We are either reading widedata or shortdata
      else Move(aRecord.Data^[aPos], pResult^, aSize);

    inc(aPos, aSize);
    inc(DestPos, aSize div CharSize);
  end else
  begin
    if (ActualOptionFlags and 1=0) and (OptionFlags and 1=1) then
      //We have to move result to widedata
      for i:=0 to l div CharSize -1 do WideData[DestPos+1+i]:=WideChar(aRecord.Data^[aPos+i])
      //We are either reading widedata or shortdata
      else  Move(aRecord.Data^[aPos], pResult^, l);
    inc(aPos, l);
    inc(DestPos, l div CharSize);
    ReadStr(aRecord, aPos, ShortData, WideData, OptionFlags, ActualOptionFlags, DestPos ,StrLen);
  end
end;

function LoadRecord(const DataStream: TStream; const RecordHeader: TRecordHeader): TBaseRecord;
var
  Data: PArrayOfByte;
  R: TBaseRecord;
  NextRecordHeader: TRecordHeader;
begin
  GetMem(Data, RecordHeader.Size);
  try
    if DataStream.Read(Data^, RecordHeader.Size) <> RecordHeader.Size then
      raise Exception.Create(ErrExcelInvalid);
  except
    FreeMem(Data);
    raise;
  end; //except

  //From here, if there is an exception, the mem will be freed by the object
  case RecordHeader.Id of
    xlr_BOF         : R:= TBOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EOF         : R:= TEOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FORMULA     : R:= TFormulaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SHRFMLA     : R:= TShrFmlaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_OBJ         : R:= TObjRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWING  : R:= TDrawingRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWINGGROUP
                    : R:= TDrawingGroupRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_TXO         : R:= TTXORecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_NOTE        : R:= TNoteRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RECALCID,   //So the workbook gets recalculated
    xlr_EXTSST,     // We will have to generate this again