Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kolekce/d567/FLEXCEL.ZIP/XLSAdapter/UXlsFormula.pas

Pascal/Delphi Source File | 2002-09-26 | 8.3 KB | 302 lines

unit UXlsFormula;

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

type
  TFormulaRecord = class(TCellRecord)
  private
    FormulaValue: variant;

    procedure ArrangeTokensInsertRows(const InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
    procedure ArrangeSharedTokens;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    procedure ArrangeInsert(const aPos, aCount:integer;  const SheetInfo: TSheetInfo);override;
    procedure ArrangeCopy(const NewRow: Word);override;
    procedure SaveToStream(const Workbook: TStream); override;

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

  TNameRecord =  class (TBaseRecord)
  private
    procedure ArrangeTokensInsertRows(const InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
    function NameLength: byte;
    function NameSize: integer;
    function OptionFlags: byte;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    procedure ArrangeInsert(aPos, aCount:integer; const SheetInfo: TSheetInfo);
    procedure ArrangeInsertSheets(const FirstSheet, SheetCount: Word);

    function ArrangeCopySheet(const SheetInfo: TSheetInfo): TNameRecord;

    function RangeSheet: integer;
    function RefersToSheet(const GetSheet:TGetSheet) : integer;
    function Name:Widestring;
    function R1: integer;
    function R2: integer;
    function C1: integer;
    function C2: integer;
  end;

  TShrFmlaRecord=class(TBaseRecord)
  public
    function FirstRow: integer;
    function LastRow: integer;
    function FirstCol: integer;
    function LastCol: integer;
    function Key: Cardinal;
  end;

implementation


{ TFormulaRecord }

procedure TFormulaRecord.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
begin
  inherited;
  ArrangeTokensInsertRows(aPos, aCount, 0, SheetInfo);
end;

constructor TFormulaRecord.Create(const aId: word;
  const aData: PArrayOfByte; const aDataSize: integer);
var
  d: double;
begin
  inherited;
  //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.
    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...Data^[14]:=Data^[14] or 2;
end;

procedure TFormulaRecord.ArrangeCopy(const NewRow: Word);
const
  SheetInfo: TSheetInfo=(InsSheet:-1;FormulaSheet:-1;GetSheet:nil;SetSheet:nil);
begin
  ArrangeTokensInsertRows( 0, 0, NewRow-Row, SheetInfo); //Sheet info doesn't have meaninig on copy
  inherited;   //should be last, so we dont modify Row
end;

procedure TFormulaRecord.ArrangeTokensInsertRows(const InsPos, InsOffset,
  CopyOffset: integer; const SheetInfo: TSheetInfo);
begin
  try
    UXlsTokenArray.ArrangeInsertRows(Data, 22, 22+GetWord(Data,20), InsPos, InsOffset, CopyOffset, SheetInfo);
  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: Cardinal): 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:=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;
end;

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

{ TNameRecord }

procedure TNameRecord.ArrangeInsertSheets(const FirstSheet, SheetCount: Word);
begin
  if (RangeSheet<>$FFFF) and (RangeSheet>=FirstSheet) then IncWord(Data, 8, SheetCount, MaxSheets+1); //NewSheet is 0 based, Data[8] is one-based;
end;

procedure TNameRecord.ArrangeTokensInsertRows(const InsPos, InsOffset,
  CopyOffset: integer; const SheetInfo: TSheetInfo);
begin
  try
    UXlsTokenArray.ArrangeInsertRows(Data, 14+ NameSize,14+ NameSize+GetWord(Data,4), InsPos, InsOffset, CopyOffset, SheetInfo);
  except
    on e: ETokenException do raise Exception.CreateFmt(ErrBadName,[ Name, e.Token]);
    else raise;
  end; //Except
end;

constructor TNameRecord.Create(const aId: word; const aData: PArrayOfByte;
  const aDataSize: integer);
begin
  inherited;

end;

procedure TNameRecord.ArrangeInsert(aPos, aCount: integer; const SheetInfo: TSheetInfo);
begin
  ArrangeTokensInsertRows( aPos, aCount, 0, SheetInfo);
end;

function TNameRecord.Name: Widestring;
var
  s: string;
begin
  if (OptionFlags and 1)=1 then
  begin
    SetLength(Result, NameLength);
    Move(Data[15], Result[1], NameLength*2);
  end else
  begin
    SetLength(s, NameLength);
    Move(Data[15], s[1], NameLength);
    Result:=s;
  end;
end;

function TNameRecord.NameLength: byte;
begin
  Result:= Data[3];
end;

function TNameRecord.NameSize: integer;
begin
  Result:= GetStrLen(false , Data, 14, true, NameLength);
end;

function TNameRecord.OptionFlags: byte;
begin
  OptionFlags:= Data[14];
end;

function TNameRecord.RangeSheet: integer;
begin
  Result:=GetWord(Data,8)-1;
end;

function TNameRecord.ArrangeCopySheet(const SheetInfo: TSheetInfo): TNameRecord;
begin
  try
    UXlsTokenArray.ArrangeInsertSheets(Data, 14+ NameSize,14+ NameSize+GetWord(Data,4), SheetInfo);
  except
    on e: ETokenException do raise Exception.CreateFmt(ErrBadName,[ Name, e.Token]);
    else raise;
  end; //Except

  SetWord(Data, 8, SheetInfo.InsSheet+1); //InsSheet is 0 based, Data[8] is one-based;
  Result:=Self;
end;

function TNameRecord.R1: integer;
begin
  if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+2+NameSize)
  else Result:=-1;
end;

function TNameRecord.R2: integer;
begin
  if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+4+NameSize)
  else Result:=-1;
end;

function TNameRecord.RefersToSheet(const GetSheet:TGetSheet): integer;
begin
  if Data[14+ NameSize] in tk_Area3d then Result:= GetSheet(GetWord(Data, 15+NameSize))
  else Result:=-1;
end;


function TNameRecord.C1: integer;
begin
  if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+6+NameSize)
  else Result:=-1;
end;

function TNameRecord.C2: integer;
begin
  if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+8+NameSize)
  else Result:=-1;
end;


{ TShrFmlaRecord }
function TShrFmlaRecord.FirstRow: integer;
begin
  Result:=GetWord(Data,0);
end;

function TShrFmlaRecord.LastRow: integer;
begin
  Result:=GetWord(Data,2);
end;

function TShrFmlaRecord.FirstCol: integer;
begin
  Result:=Data[4];
end;

function TShrFmlaRecord.LastCol: integer;
begin
  Result:=Data[5];
end;

function TShrFmlaRecord.Key: cardinal;
begin
  Result:=GetWord(Data,0) or Data[4] shl 16;
end;


end.