uxlsformula.pas

TMS Component Pack Pro v4.2

{ TNameRecord }

procedure TNameRecord.ArrangeInsertSheets(const FirstSheet, SheetCount: integer);
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.ArrangeTokensInsertRowsAndCols(const InsRowPos, InsRowOffset,
  CopyRowOffset, InsColPos, InsColOffset, CopyColOffset: integer; const SheetInfo: TSheetInfo);
begin
  try
    UXlsTokenArray.ArrangeInsertRowsAndCols(Data, 14+ NameSize,14+ NameSize+GetWord(Data,4), InsRowPos, InsRowOffset, CopyRowOffset, InsColPos, InsColOffset, CopyColOffset, SheetInfo, true);
  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.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo);
begin
  ArrangeTokensInsertRowsAndCols( aRowPos, aRowCount, 0, aColPos, aColCount, 0, SheetInfo);
end;

function TNameRecord.Name: Widestring;
var
  s: string;
begin
  if (NameOptionFlags 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.NameOptionFlags: byte;
begin
  Result:= 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.GetR1: integer;
begin
  if GetWord(Data,4)<=0 then Result:=-1
  else if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+2+NameSize)
  else if Data[14+ NameSize] in tk_Ref3d then Result:= GetWord(Data, 15+2+NameSize)
  else Result:=-1;
end;

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

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


function TNameRecord.GetC1: integer;
begin
  if GetWord(Data,4)<=0 then Result:=-1
  else if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+6+NameSize) and $FF
  else if Data[14+ NameSize] in tk_Ref3d then Result:= GetWord(Data, 15+4+NameSize) and $FF
  else Result:=-1;
end;

function TNameRecord.GetC2: integer;
begin
  if GetWord(Data,4)<=0 then Result:=-1
  else if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+8+NameSize) and $FF
  else if Data[14+ NameSize] in tk_Ref3d then Result:= GetWord(Data, 15+4+NameSize) and $FF
  else Result:=-1;
end;


procedure TNameRecord.SetC1(value: integer);
begin
  if GetWord(Data,4)<=0 then exit;
  if Data[14+ NameSize] in tk_Ref3d then ChangeRefToArea;
  if Data[14+ NameSize] in tk_Area3d then SetWord(Data, 15+6+NameSize, value and $FF)
end;

procedure TNameRecord.SetC2(value: integer);
begin
  if GetWord(Data,4)<=0 then exit;
  if Data[14+ NameSize] in tk_Ref3d then ChangeRefToArea;
  if Data[14+ NameSize] in tk_Area3d then SetWord(Data, 15+8+NameSize, value and $FF)
end;

procedure TNameRecord.SetR1(value: integer);
begin
  if GetWord(Data,4)<=0 then exit;
  if Data[14+ NameSize] in tk_Ref3d then ChangeRefToArea;
  if Data[14+ NameSize] in tk_Area3d then SetWord(Data, 15+2+NameSize, value and $FF)
end;

procedure TNameRecord.SetR2(value: integer);
begin
  if GetWord(Data,4)<=0 then exit;
  if Data[14+ NameSize] in tk_Ref3d then ChangeRefToArea;
  if Data[14+ NameSize] in tk_Area3d then SetWord(Data, 15+4+NameSize, value and $FF)
end;

procedure TNameRecord.ChangeRefToArea;
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+4;
  ReallocMem(Data, NewDataSize);
  DataSize:=NewDataSize;

  Data[14+ NameSize]:=Data[14+ NameSize]+1; //Convert to area.
  SetWord(Data, 4, GetWord(Data, 4)+4); //Length of name record.
  System.Move(Data[14+NameSize+6], Data[14+NameSize+10], DataSize-14-NameSize-10);
  SetWord(Data, 14+NameSize+6, GetWord(Data, 14+NameSize+4));
  SetWord(Data, 14+NameSize+8, GetWord(Data, 14+NameSize+4));
  SetWord(Data, 14+NameSize+4, GetWord(Data, 14+NameSize+2));
end;

constructor TNameRecord.CreateFromData(const Range: TXlsNamedRange;
  const Globals: pointer; const CellList: pointer);
var
  es: TExcelString;
  Fmla: array of byte;
  DefaultSheet: integer;
  DefaultSheetName: WideString;
  Ps: TParseString;
  sht: integer;
begin
  Create(xlr_NAME, nil, 0);
  es := TExcelString.Create(1, Range.Name);
  try
    Fmla := nil;
    if (Length(Trim(Range.RangeFormula)) <= 0) then exit;

    DefaultSheet := 0;
    if Range.NameSheetIndex >= 0 then
      DefaultSheet := Range.NameSheetIndex;

    DefaultSheetName := TWorkbookGlobals(Globals).SheetName[DefaultSheet];
    Ps := TParseString.CreateExt(Range.RangeFormula, TWorkbookGlobals(Globals).Names, CellList, true, DefaultSheetName, fmRef);
    try
      Ps.Parse;
      SetLength(Fmla, Ps.TotalSize - 2);
      Ps.CopyToPtrNoLen(PArrayOfByte(Fmla), 0);
    finally
      FreeAndNil(Ps);
    end; //finally

    DataSize := ((es.TotalSize - 1) + 14) + Length(Fmla);
    GetMem (Data, DataSize);
    FillChar(Data[0], DataSize, 0);
    SetWord(Data, 0, Range.OptionFlags and 65535);
    Data[3] := Byte(Length(Range.Name));
    SetWord(Data, 4, Length(Fmla));
    if Range.NameSheetIndex >= 0 then
    begin
      sht := Range.NameSheetIndex + 1; // SetSheet(Range.NameSheetIndex)+1; .Despite what the docs say, this is the sheetindex+1 not the externsheetindex.
      SetWord(Data, 6, sht);
      SetWord(Data, 8, sht);
    end;

    es.CopyToPtr(Data, 14, false);
    move(Fmla[0], Data[(14 + es.TotalSize) - 1], Length(Fmla));
  finally
    FreeAndNil(es);
  end;
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.DoCopyTo: TBaseRecord;
begin
  Result:=inherited DoCopyTo;
  (Result as TShrFmlaRecord).Key:=Key;
end;


{ TTableRecord }

procedure TTableRecord.ArrangeCopyRowsAndCols(const DeltaRow, DeltaCol: integer);
begin
  if (GetWord(Data,0) <>$FFFF) then IncWord(Data, 0, DeltaRow, Max_Rows); //Here we raise an error, can't insert past the bound of a sheet.
  if (GetWord(Data,2) <>$FFFF) then IncWord(Data, 2, DeltaRow, Max_Rows);
  if (Data[4] <>$FF) then IncWord(Data, 4, DeltaCol, Max_Columns);
  if (Data[5] <>$FF) then IncWord(Data, 5, DeltaCol, Max_Columns);

  if (GetWord(Data,8) <>$FFFF) then IncRowToMax(Data, 8, 10, DeltaRow, Max_Rows);  //here, we create an invalid ref
  if (GetWord(Data,12) <>$FFFF) then IncRowToMax(Data, 12, 14, DeltaRow, Max_Rows);
  if (Data[10] <>$FF) then IncColToMax(Data, 8, 10, DeltaCol, Max_Columns);
  if (Data[14] <>$FF) then IncColToMax(Data, 12, 14, DeltaCol, Max_Columns);
end;

procedure TTableRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer);
begin
  //Increment the position of the table. Here we give an error if we pass the maximum value, or wi would be loosing data
  if (GetWord(Data,0) >=aRowPos)and (GetWord(Data,0) <>$FFFF) then IncWord(Data, 0, aRowCount, Max_Rows);
  if (GetWord(Data,2) >=aRowPos)and (GetWord(Data,2) <>$FFFF) then IncWord(Data, 2, aRowCount, Max_Rows);
  if (Data[4] >=aColPos) and (Data[4] <>$FF) then IncByte(Data, 4, aColCount, Max_Columns);
  if (Data[5] >=aColPos) and (Data[5] <>$FF) then IncByte(Data, 5, aColCount, Max_Columns);

  //Increment the entry cells. If they go out of limits, we should replace them with #ref
  if (GetWord(Data,8) >=aRowPos)and (GetWord(Data,8) <>$FFFF) then IncRowToMax(Data, 8, 10, aRowCount, Max_Rows);
  if (GetWord(Data,12) >=aRowPos)and (GetWord(Data,12) <>$FFFF) then IncRowToMax(Data, 12, 14, aRowCount, Max_Rows);
  if (Data[10] >=aColPos) and (Data[10] <>$FF) then IncColToMax(Data, 8, 10, aColCount, Max_Columns);
  if (Data[14] >=aColPos) and (Data[14] <>$FF) then IncColToMax(Data, 12, 14, aColCount, Max_Columns);
end;

constructor TTableRecord.Create(const aId: word; const aData: PArrayOfByte;
  const aDataSize: integer);
begin
  inherited;
  SetWord(Data, 6, GetWord(Data, 6) or 3); // Calc on load...
end;

procedure TTableRecord.IncColToMax(const Pdata: PArrayOfByte; const rowPos, colPos,
  Offset, Max: integer);
var
  v: int64;
begin
  v:=Pdata[colPos];
  v:=v+Offset;
  if (v>Max) or (v<0) then begin; SetWord(PData,rowPos,$FFFF); SetWord(PData,colPos,$FFFF); end  //Invalid ref
  else
  begin
    Pdata[colPos]:=v;
  end;
end;

procedure TTableRecord.IncRowToMax(const Pdata: PArrayOfByte; const rowPos, colPos,
  Offset, Max: integer);
var
  v: int64;
begin
  v:=GetWord(Pdata,rowPos);
  v:=v+Offset;
  if (v>Max) or (v<0) then begin; SetWord(PData,rowPos,$FFFF); SetWord(PData,colPos,$FFFF); end  //Invalid ref
    else SetWord(Pdata,RowPos,v);
end;

{ TArrayRecord }

procedure TArrayRecord.ArrangeCopyRowsAndCols(const DeltaRow, DeltaCol: integer);
begin
  //Pending:
end;

procedure TArrayRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer);
begin
  //Pending:
end;

end.