uxlsrowcolentries.pas

TMS Component Pack Pro v4.2

      RTFRuns:= Copy(Rs.RTFRuns);
    end else V.Value:=Items[Row][Index].Value;

  end else
  begin
    V.Value:=Unassigned;
    V.XF:=-1;
    V.IsFormula:=false;
  end;
end;

function TCellList.GetValue(Row, Col: integer): TXlsCellValue;
var
  RTFRuns: TRTFRunList;
begin
  GetValueX2(Row, Col, Result, RTFRuns);
end;

procedure TCellList.SetValue(Row, Col: integer; const Value: TXlsCellValue);
begin
  SetValueX2(Row, col, Value, nil);
end;

procedure TCellList.SetValueX2(const Row, Col: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList);
var
  Index, k: integer;
  XF, DefaultXF: integer;
  Found: boolean;
  Cell: TCellRecord;
  ValueType: integer;
  Rs: TRichString;
begin
  if (Row<0) or (Row>Max_Rows) then raise Exception.CreateFmt(ErrInvalidRow,[Row]);
  if (Col>Max_Columns)or (Col<0) then raise Exception.CreateFmt(ErrInvalidCol,[Col]);

  FRowRecordList.AddRow(Row);

  if FRowRecordList[Row].IsFormatted then DefaultXF:=FRowRecordList[Row].XF
  else if FColInfoList.Find(Col, Index) then DefaultXF:=FColInfoList[Index].XF
  else DefaultXF:=15;

  Cell:=nil;
  Found:=(Row<Count) and Items[Row].Find(Col,Index);
  XF:=DefaultXF;
  if Found then XF:=Items[Row][Index].XF;
  if Value.XF>=0 then XF:=Value.XF;


  ValueType:= VarType(Value.Value);

  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14}
  //Check for Custom Variants
  if (ValueType>=$010F) and (ValueType<=$0FFF) then
  begin
    ValueType:=VarDouble; //should be VarType(OleVariant(Value.Value)), but this converts numbers to strings
  end;
  {$IFEND}{$ENDIF} //Delphi 6 or above

  case ValueType of
    varEmpty,
    varNull      : if (XF<>DefaultXF) then Cell:= TBlankRecord.CreateFromData(Row,Col,XF);

    varByte,
    varSmallint,
    varInteger,
    varSingle,
    varDouble,
    {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14}
      varShortInt, VarWord, VarLongWord, varInt64,
    {$IFEND}{$ENDIF} //Delphi 6 or above
    varCurrency : if IsRK(Value.Value) then Cell:= TRKRecord.CreateFromData(Row,Col,XF)
                                 else Cell:= TNumberRecord.CreateFromData(Row,Col,XF);

    varDate     : Cell:= TLabelSSTRecord.CreateFromData(Row,Col,XF,FGlobals.SST);

    varOleStr,
    varStrArg,
    varString   : if (Value.Value='') then
                  begin
                    if (XF<>DefaultXF) then Cell:= TBlankRecord.CreateFromData(Row,Col,XF);
                  end
                  else Cell:= TLabelSSTRecord.CreateFromData(Row,Col,XF,FGlobals.SST);

    varBoolean	: Cell:= TBoolErrRecord.CreateFromData(Row,Col,XF);
  end; //case

  if Found then Items[Row].Delete(Index);


  if Found and (Cell=nil) then  //We are deleting a cell
  begin
    if (Row>=Count) or (Items[Row]=nil)or(Items[Row].Count=0)then //Row emptied
      if (not FRowRecordList[Row].IsModified)  then     //Row always exists... it is added at the top
        FRowRecordList[Row]:=nil  //this frees the object
      else
      begin
        FRowRecordList[Row].MinCol:= 0;
        FRowRecordList[Row].MaxCol:= 0;
      end
    else
    begin
      FRowRecordList[Row].MinCol:= Items[Row][0].Column;
      FRowRecordList[Row].MaxCol:= Items[Row][Items[Row].Count-1].Column+1;
    end;
  end;

  //Remove all empty Rows at the end.
  k:=FRowRecordList.Count-1;
  while ((k>Row) or (Cell=nil)) and
        (k>=0) and (not FRowRecordList.HasRow(k) or (not FRowRecordList[k].IsModified)) and
        ((k>=Count) or (Items[k]=nil) or (Items[k].Count=0)) do
  begin
    FRowRecordList.Delete(k);
    if k<Count then Delete(k);
    dec(k);
  end;

  if Cell=nil then exit;

  if Col+1> FRowRecordList[Row].MaxCol then FRowRecordList[Row].MaxCol:=Col+1;
  if Col< FRowRecordList[Row].MinCol then FRowRecordList[Row].MinCol:=Col;

  if (Cell is TLabelSSTRecord) and (Length(RTFRuns)>0) then
  begin
    Rs.Value:=Value.Value;
    Rs.RTFRuns:=Copy(RTFRuns);
    (Cell as TLabelSSTRecord).AsRichString:=Rs;
  end else
  Cell.Value:=Value.Value;
  if Row>=Count then AddRecord(Cell, Row) else Items[Row].Insert(Index, Cell);
end;

procedure TCellList.FixFormulaTokens(const Formula: TFormulaRecord; const ShrFmlas: TShrFmlaRecordList);
var
  Key: Cardinal;
  Index: integer;
begin
  if not Formula.IsExp(Key) then exit;
  if ShrFmlas.Find(Key, Index) then
    Formula.MixShared(ShrFmlas[Index].Data, ShrFmlas[Index].DataSize)
  else //Array formula
  begin
    //nothing, it's ok
    //raise Exception.Create(ErrShrFmlaNotFound);
  end;
end;

procedure TCellList.FixFormulas(const ShrFmlas: TShrFmlaRecordList);
var
  i, k: integer;
  it: TCellRecordList;
  OldFormulaSize: integer;
begin
  for i:=0 to Count-1 do
  begin
    it:=Items[i];
    for k:=0 to it.Count-1 do
      if it.Items[k] is TFormulaRecord then
      begin
        OldFormulaSize:=(it.Items[k] as TFormulaRecord).DataSize;
        FixFormulaTokens(it.Items[k] as TFormulaRecord, ShrFmlas);
        it.AdaptSize((it.Items[k] as TFormulaRecord).DataSize-OldFormulaSize);
      end;
  end;
end;

function TCellList.GetFormula(Row, Col: integer): widestring;
{$IFNDEF TMSASGx}
var
  Index: integer;
{$ENDIF}
begin
{$IFDEF TMSASGx}
  Result:='';
{$ELSE}
  if (Row<0) or (Row>Max_Rows) then raise Exception.CreateFmt(ErrInvalidRow,[Row]);
  if (Col>Max_Columns)or (Col<0) then raise Exception.CreateFmt(ErrInvalidCol,[Col]);
  if Row>=Count then begin; Result:=''; exit; end;
  if Items[Row].Find(Col,Index) and (Items[Row][Index] is TFormulaRecord) then
  begin
    Result:=RPNToString(Items[Row][Index].Data, 22, FGlobals.Names, Self);
  end else
  begin
    Result:='';
  end;
{$ENDIF}
end;

procedure TCellList.SetFormula(Row, Col: integer; const Value: widestring);
begin
  AssignFormulaX(Row, Col, Value, unassigned);
end;

function TCellList.ArrayFormula(const Row, Col: integer): PArrayOfByte;
var
  Index: integer;
  Fmla: TFormulaRecord;
begin
  if (Row<0) or (Row>=Count) then raise Exception.CreateFmt(ErrInvalidRow,[Row]);
  if (Col>Max_Columns)or (Col<0) then raise Exception.CreateFmt(ErrInvalidCol,[Col]);
  if Items[Row].Find(Col,Index) and (Items[Row][Index] is TFormulaRecord) then
  begin
    Fmla:=(Items[Row][Index] as TFormulaRecord);
    if Fmla.ArrayRecord=nil then raise Exception.CreateFmt(ErrBadFormula,[Row, Col,1]);
    Result:=Fmla.ArrayRecord.Data;
  end else
  begin
    raise Exception.Create(ErrShrFmlaNotFound);
  end;
end;

function TCellList.TableFormula(const Row, Col: integer): PArrayOfByte;
var
  Index: integer;
  Fmla: TFormulaRecord;
begin
  if (Row<0) or (Row>=Count) then raise Exception.CreateFmt(ErrInvalidRow,[Row]);
  if (Col>Max_Columns)or (Col<0) then raise Exception.CreateFmt(ErrInvalidCol,[Col]);
  if Items[Row].Find(Col,Index) and (Items[Row][Index] is TFormulaRecord) then
  begin
    Fmla:=(Items[Row][Index] as TFormulaRecord);
    if Fmla.TableRecord=nil then raise Exception.CreateFmt(ErrBadFormula,[Row, Col,1]);
    Result:=(Items[Row][Index] as TFormulaRecord).TableRecord.Data;
  end else
  begin
    raise Exception.Create(ErrShrFmlaNotFound);
  end;
end;

function TCellList.GetSheetName(const SheetNumber: integer): widestring;
begin
  Result:= FGlobals.References.GetSheetName(SheetNumber, FGlobals);
end;

function TCellList.FindSheet(SheetName: widestring; out SheetIndex: Integer): Boolean;
var
  i: Integer;
begin
  SheetName:=WideUpperCase98(SheetName);
  for i:=0 to FGlobals.SheetCount-1 do
  begin
    if SheetName= UpperCase(FGlobals.SheetName[i]) then
    begin
      SheetIndex := i;
      Result := True;
      exit;
    end;
  end;
  SheetIndex := -1;
  Result := False;
end;

function TCellList.AddExternSheet(const FirstSheet: Integer; const LastSheet: Integer): Integer;
begin
  Result := FGlobals.References.AddSheet(FGlobals.SheetCount, FirstSheet, LastSheet);
end;



procedure TCellList.AssignFormulaX(const Row, Col: integer; const Formula: widestring; const Value: variant);
{$IFNDEF TMSASGx}
var
  Cell: TCellRecord;
  ds: integer;
  Ps: TParseString;
  Index, k: integer;
  XF, DefaultXF: integer;
  Found: boolean;
{$ENDIF}
begin
{$IFNDEF TMSASGx}
  if (Row<0) or (Row>Max_Rows) then raise Exception.CreateFmt(ErrInvalidRow,[Row]);
  if (Col>Max_Columns)or (Col<0) then raise Exception.CreateFmt(ErrInvalidCol,[Col]);
  FRowRecordList.AddRow(Row);
  if FRowRecordList[Row].IsFormatted then DefaultXF:=FRowRecordList[Row].XF
  else if FColInfoList.Find(Col, Index) then DefaultXF:=FColInfoList[Index].XF
  else DefaultXF:=15;

  Cell:=nil;
  Found:=(Row<Count) and Items[Row].Find(Col,Index);
  XF:=DefaultXF;
  if Found then XF:=Items[Row][Index].XF;
  //if Formula.XF>=0 then XF:=Formula.XF;

  if Formula='' then Cell:=nil else
  begin
    Ps:=TParseString.Create(Formula, FGlobals.Names, Self);
    try
      Ps.Parse;
      ds:= Ps.TotalSize+20;
      Cell:= TFormulaRecord.CreateFromData(xlr_FORMULA, ds, Row, Col, XF, Value);
      Ps.CopyToPtr(Cell.Data, 20);
    finally
      FreeAndNil(Ps);
    end;
  end;

  try
    if Found then Items[Row].Delete(Index);

    if Found and (Cell=nil) then  //We are deleting a cell
    begin
      if (Row>=Count) or (Items[Row]=nil)or(Items[Row].Count=0)then //Row emptied
        if (not FRowRecordList[Row].IsModified)  then     //Row always exists... it is added at the top
          FRowRecordList[Row]:=nil  //this frees the object
        else
        begin
          FRowRecordList[Row].MinCol:= 0;
          FRowRecordList[Row].MaxCol:= 0;
        end
      else
      begin
        FRowRecordList[Row].MinCol:= Items[Row][0].Column;
        FRowRecordList[Row].MaxCol:= Items[Row][Items[Row].Count-1].Column+1;
      end;
    end;

    //Remove all empty Rows at the end.
    k:=FRowRecordList.Count-1;
    while ((k>Row) or (Cell=nil)) and
          (k>=0) and (not FRowRecordList.HasRow(k) or (not FRowRecordList[k].IsModified)) and
          ((k>=Count) or (Items[k]=nil) or (Items[k].Count=0)) do
    begin
      FRowRecordList.Delete(k);