uxlsformula.pas

TMS Component Pack Pro v4.2

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

interface
uses
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  Classes, SysUtils, UXlsBaseRecords, XlsMessages, UXlsTokenArray, XlsFormulaMessages, UFlxMessages,
  UXlsStrings;

type
  TTableRecord = class(TBaseRecord)
  private
    procedure IncRowToMax( const Pdata: PArrayOfByte; const rowPos, colPos: integer; const Offset: integer; const Max: integer);
    procedure IncColToMax( const Pdata: PArrayOfByte; const rowPos, colPos: integer; const Offset: integer; const Max: integer);
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer);
    procedure ArrangeCopyRowsAndCols(const DeltaRow, DeltaCol: integer);
  end;

  TArrayRecord=class(TBaseRecord)
  public
    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer);
    procedure ArrangeCopyRowsAndCols(const DeltaRow, DeltaCol: integer);
  end;

  TFormulaRecord = class(TCellRecord)
  private
    FormulaValue: variant;
    FTableRecord: TTableRecord;
    FArrayRecord: TArrayRecord;

    procedure ArrangeTokensInsertRowsAndCols(const InsRowPos, InsRowOffset, CopyRowOffset,InsColPos, InsColOffset, CopyColOffset: integer; const SheetInfo: TSheetInfo);
    procedure ArrangeSharedTokens;
    procedure SetTableRecord(const Value: TTableRecord);
    procedure SetArrayRecord(const Value: TArrayRecord);
  protected
    function DoCopyTo: TBaseRecord; override;

  public

    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    constructor CreateFromData(const aId, aDataSize, aRow, aCol, aXF: word; const aValue: variant);
    destructor Destroy;override;
    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer;  const SheetInfo: TSheetInfo);override;
    procedure ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);override;
    procedure SaveToStream(const Workbook: TStream); override;

    function TotalSize: integer;override;
    function TotalSizeNoHeaders: integer;override;

    property TableRecord: TTableRecord read FTableRecord write SetTableRecord;
    property ArrayRecord: TArrayRecord read FArrayRecord write SetArrayRecord;

    function IsExp(var Key: LongWord): boolean;
    procedure MixShared(const PData: PArrayOfByte; const aDataSize: integer);
    function GetValue: Variant; override;
    procedure SetFormulaValue(const v: variant);
  end;

  TNameRecord =  class (TBaseRecord)
  private
    procedure ArrangeTokensInsertRowsAndCols(const InsRowPos, InsRowOffset, CopyRowOffset,InsColPos, InsColOffset, CopyColOffset: integer; const SheetInfo: TSheetInfo);
    function NameLength: byte;
    function NameSize: integer;
    function NameOptionFlags: byte;

    procedure ChangeRefToArea;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    constructor CreateFromData(const Range: TXlsNamedRange; const Globals: pointer; const CellList: pointer);

    procedure ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);
    procedure ArrangeInsertSheets(const FirstSheet, SheetCount: integer);

    function ArrangeCopySheet(const SheetInfo: TSheetInfo): TNameRecord;

    function RangeSheet: integer;
    function RefersToSheet(const GetSheet:TGetSheet) : integer;
    function Name:Widestring;
    function GetR1: integer;
    function GetR2: integer;
    function GetC1: integer;
    function GetC2: integer;

    procedure SetR1(value: integer);
    procedure SetR2(value: integer);
    procedure SetC1(value: integer);
    procedure SetC2(value: integer);
  end;

  TShrFmlaRecord=class(TBaseRecord)
  public
    Key: LongWord;  //This is the last formula Row+ last cormula col shr 16. Used to know which cell this is attached to.

    //We don't really need to implement a CopyTo, since this record is used temporary only. But, for consistency:
    protected
        function DoCopyTo: TBaseRecord; override;
    public
    function FirstRow: integer;
    function LastRow: integer;
    function FirstCol: integer;
    function LastCol: integer;
  end;


implementation
uses UxlsEncodeFormula, UXlsWorkbookGlobals;

{ TFormulaRecord }

procedure TFormulaRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);
begin
  inherited;
  ArrangeTokensInsertRowsAndCols(aRowPos, aRowCount, 0, aColPos,aColCount,0, SheetInfo);
  if (FTableRecord<>nil) and (SheetInfo.FormulaSheet=SheetInfo.InsSheet) then FTableRecord.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount);
  if (FArrayRecord<>nil) and (SheetInfo.FormulaSheet=SheetInfo.InsSheet) then FArrayRecord.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount);
end;

constructor TFormulaRecord.Create(const aId: word;
  const aData: PArrayOfByte; const aDataSize: integer);
var
  d: double;
  b: byte;
begin
  inherited;
  ArrayRecord:=nil;
  //Save the formula result
  FormulaValue:=unassigned;
  if GetWord(Data,12)<> $FFFF then //it's a number
  begin
    move(Data[6], d, sizeof(d));
    FormulaValue:=d;
  end else
  begin
    case Data[6] of
      0: FormulaValue:=''; //It's a string. We will fill it later when we read the string record
      1: FormulaValue:=data[8]=1; //boolean
      //2 is error. we can't codify this on a variant.
      2:
      begin
           b:= Data[8];
           if b= fmiErrNull  then FormulaValue:=fmErrNull else
           if b= fmiErrDiv0  then FormulaValue:=fmErrDiv0 else
           if b= fmiErrValue then FormulaValue:=fmErrValue else
           if b= fmiErrRef   then FormulaValue:=fmErrRef else
           if b= fmiErrName  then FormulaValue:=fmErrName else
           if b= fmiErrNum   then FormulaValue:=fmErrNum else
           if b= fmiErrNA    then FormulaValue:=fmErrNA;
      end;
    end; //case
  end;

  FillChar(Data^[6],8,0); //clear result
  Data^[6]:=2; //error value
  SetWord(Data,12,$FFFF);
  FillChar(Data^[16],4,0); //clear chn

  // For automatic recalc on Excel97...
  Data^[14]:=Data^[14] or 2;
end;

constructor TFormulaRecord.CreateFromData(const aId, aDataSize, aRow, aCol, aXF: word; const aValue: variant);
var
  d: double;
begin
  inherited CreateFromData(aId, aDataSize, aRow, aCol, aXF);

  FormulaValue:=unassigned;
  case VarType(aValue) of
    varEmpty,
    varNull      : begin FormulaValue:=unassigned; end;

    varByte,
    varSmallint,
    varInteger,
    varSingle,
    varDouble,
    VarDate,
    {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14}
      varShortInt, VarWord, VarLongWord, varInt64,
    {$IFEND}{$ENDIF} //Delphi 6 or above
    varCurrency :
    begin
      d:= aValue;
      move(d, Data[6],  sizeof(d));
      FormulaValue:=d;
    end;

    varOleStr,
    varStrArg,
    varString   :
    begin
    {
      Data[6]:=0;
      SetWord(Data, 12, $FFFF);
      //pending to create a string record.
      FormulaValue:=aValue;
    }
    end;
    
    varBoolean	:
    begin
      Data[6]:=1;
      Data[7]:=0;
      if aValue then Data[8]:=1 else Data[8]:=0;
      //no need to set 0s really. Formula result has been cleared on inherited constructor.
      SetWord(Data, 12, $FFFF);

      FormulaValue:=aValue;
    end;
  end; //case

 end;

procedure TFormulaRecord.ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);
const
  SheetInfo: TSheetInfo=(InsSheet:-1;FormulaSheet:-1;GetSheet:nil;SetSheet:nil;Names:nil);
begin
  ArrangeTokensInsertRowsAndCols( 0, 0, RowOffset, 0, 0, ColOffset, SheetInfo); //Sheet info doesn't have meaninig on copy
  if (FTableRecord<>nil) and (SheetInfo.FormulaSheet=SheetInfo.InsSheet) then FTableRecord.ArrangeCopyRowsAndCols(RowOffset, ColOffset);
  if (FArrayRecord<>nil) and (SheetInfo.FormulaSheet=SheetInfo.InsSheet) then FArrayRecord.ArrangeCopyRowsAndCols(RowOffset, ColOffset);
  inherited;   //should be last, so we dont modify Row or Col
end;

procedure TFormulaRecord.ArrangeTokensInsertRowsAndCols(const InsRowPos, InsRowOffset,
  CopyRowOffset, InsColPos, InsColOffset, CopyColOffset: integer; const SheetInfo: TSheetInfo);
begin
  try
    UXlsTokenArray.ArrangeInsertRowsAndCols(Data, 22, 22+GetWord(Data,20), InsRowPos, InsRowOffset, CopyRowOffset, InsColPos, InsColOffset, CopyColOffset, SheetInfo, true);
  except
    on e: ETokenException do raise Exception.CreateFmt(ErrBadFormula,[ Row+1, Column+1, e.Token]);
    else raise;
  end; //Except
end;

procedure TFormulaRecord.ArrangeSharedTokens;
begin
  try
    UXlsTokenArray.ArrangeSharedFormulas(Data, 22, 22+GetWord(Data,20), Row, Column);
  except
    on e: ETokenException do raise Exception.CreateFmt(ErrBadFormula,[ Row+1, Column+1, e.Token]);
    else raise;
  end; //Except
end;

function TFormulaRecord.IsExp(var Key: LongWord): boolean;
begin
  Result:= (DataSize=27) and (GetWord(Data,20)=5) and (Data[22]=1);
  if Result then Key:=GetWord(Data,23) or (GetWord(Data,25) shl 16);
end;

procedure TFormulaRecord.MixShared(const PData: PArrayOfByte; const aDataSize: integer);
var
  NewDataSize: integer;
begin
  //Important: This method changes the size of the record without notifying it's parent list
  //It's necessary to adapt the Totalsize in the parent list.
  NewDataSize:=20+aDataSize-8;  //DataSize - 5+ aDataSize-8 ;
  ReallocMem(Data, NewDataSize);
  //Now is safe to change DataSize
  DataSize:=NewDataSize;
  Move(PData[8], Data[20], aDataSize-8);
  ArrangeSharedTokens;
end;

function TFormulaRecord.GetValue: Variant;
begin
  Result:=FormulaValue;
end;

procedure TFormulaRecord.SaveToStream(const Workbook: TStream);
begin
  inherited;
  if FArrayRecord<>nil then FArrayRecord.SaveToStream(Workbook);
  if FTableRecord<>nil then FTableRecord.SaveToStream(Workbook);
end;

procedure TFormulaRecord.SetFormulaValue(const v: variant);
begin
  FormulaValue:=v;
end;

function TFormulaRecord.DoCopyTo: TBaseRecord;
begin
  Result:=inherited DoCopyTo;
  (Result as TFormulaRecord).TableRecord:= (FTableRecord.CopyTo as TTableRecord);
  (Result as TFormulaRecord).ArrayRecord:= (FArrayRecord.CopyTo as TArrayRecord);
end;

function TFormulaRecord.TotalSize: integer;
begin
  Result:=inherited TotalSize;
  if FTableRecord<>nil then inc(Result, FTableRecord.TotalSize);
  if FArrayRecord<>nil then inc(Result, FArrayRecord.TotalSize);
end;

function TFormulaRecord.TotalSizeNoHeaders: integer;
begin
  Result:=inherited TotalSizeNoHeaders;
  if FTableRecord<>nil then inc(Result, FTableRecord.TotalSizeNoHeaders);
  if FArrayRecord<>nil then inc(Result, FArrayRecord.TotalSizeNoHeaders);
end;

destructor TFormulaRecord.Destroy;
begin
  FreeAndNil(FTableRecord);
  FreeAndNil(FArrayRecord);
  inherited;
end;

procedure TFormulaRecord.SetTableRecord(const Value: TTableRecord);
begin
  if FTableRecord<>nil then FreeAndNil(FTableRecord);
  FTableRecord := Value;
end;

procedure TFormulaRecord.SetArrayRecord(const Value: TArrayRecord);
begin
  if FArrayRecord<>nil then FreeAndNil(FArrayRecord);
  FArrayRecord := Value;
end;