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

Pascal/Delphi Source File | 2002-10-03 | 13.7 KB | 463 lines

unit UXlsRowColEntries;

interface
uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords,
     XlsMessages, UXlsRangeRecords, UXlsBaseList, UXlsCellRecords, UXlsFormula,
     {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
     UXlsSST, UFlxMessages, UXlsColInfo;

type
  TListClass= class of TBaseRowColRecordList;

  TBaseRowColList = class(TBaseList) //records are TBaseRowColRecordList
    {$INCLUDE TBaseRowColListHdr.inc}
  protected
    ListClass: TListClass;
  public
    procedure AddRecord(const aRecord: TBaseRowColRecord; const aRow: integer);

    procedure CopyFrom(const aList: TBaseRowColList);

    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);

    constructor Create(const aListClass: TListClass);
  end;

  TCellList = class (TBaseRowColList)//records are TCellRecordList
  private
    FSST: TSST;
    FRowRecordList: TRowRecordList;
    FColInfoList: TColInfoList;

    function GetValue(Row, Col: integer): TXlsCellValue;
    procedure SetValue(Row, Col: integer; const Value: TXlsCellValue);
    procedure FixFormulaTokens(const Formula: TFormulaRecord; const ShrFmlas: TShrFmlaRecordList);
    function GetMaxCol(Row: integer): integer;
    {$INCLUDE TCellListHdr.inc}
  public
    constructor Create(const aSST: TSST; const aRowRecordList: TRowRecordList; const aColInfoList: TColInfoList);
    property Value[Row,Col:integer]:TXlsCellValue  read GetValue write SetValue;
    property MaxCol[Row: integer]: integer read GetMaxCol;

    procedure FixFormulas(const ShrFmlas: TShrFmlaRecordList);
  end;

  TCells = class
  private
    FRowList: TRowRecordList;
    FCellList: TCellList;
  public
    constructor Create(const aSST: TSST; const aColInfoList: TColInfoList);
    destructor Destroy; override;

    procedure Clear;
    procedure CopyFrom(const aList: TCells);

    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);

    procedure AddRow(const aRecord: TRowRecord);
    procedure AddCell(const aRecord: TCellRecord;  const aRow: integer);
    procedure AddMultipleCells(const aRecord: TMultipleValueRecord);

    property CellList: TCellList read FCellList;
    property RowList: TRowRecordList read FRowList;
  end;


  TRangeList = class(TBaseList) //records are TRangeEntry
    {$INCLUDE TRangeListHdr.inc}
    procedure CopyFrom(const aRangeList: TRangeList);

    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo);
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);

  end;

implementation
{ TBaseRowColList }

{$INCLUDE TBaseRowColListImp.inc}

procedure TBaseRowColList.AddRecord(const aRecord: TBaseRowColRecord; const aRow: integer);
var
  i:integer;
begin
  for i:= Count to aRow do Add(ListClass.Create);
  Items[aRow].Add(aRecord);
end;

procedure TBaseRowColList.ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].ArrangeInsert(InsPos, InsCount, SheetInfo);
end;

procedure TBaseRowColList.CopyFrom(const aList: TBaseRowColList);
var
  i: integer;
  Tr: TBaseRowColRecordList;
begin
  for i:=0 to aList.Count - 1 do
  begin
    Tr:= ListClass.Create;
    Tr.CopyFrom(aList[i]);
    Add(Tr);
  end;
end;

constructor TBaseRowColList.Create(const aListClass: TListClass);
begin
  inherited Create(true);
  ListClass:=aListClass;
end;

procedure TBaseRowColList.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
var
  i, Max: integer;
begin
  Max:=aRow+aCount ; if Max>Count then Max:= Count;
  for i:= Max-1 downto aRow do Delete(i);
  //Delete the cells. we have to look at all the formulas, not only those below arow
  ArrangeInsert(aRow, -aCount, SheetInfo);

end;

procedure TBaseRowColList.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
var
  i, k, z, a, CopyOffs, MyDestRow: integer;
  aRecordList: TBaseRowColRecordList;
begin
  // Insert the cells. we have to look at all the formulas, not only those below destrow
  ArrangeInsert(DestRow, aCount*(LastRow-FirstRow+1), SheetInfo);

  //Copy the cells
  MyDestRow:=DestRow;
  CopyOffs:=0;
  for k:=1 to aCount do
    for i:=FirstRow to LastRow do
    begin
      aRecordList:= ListClass.Create;
      try
        if i+CopyOffs<Count then
        begin
          if OnlyFormulas then
          begin
            for a:=0 to Items[i+CopyOffs].Count-1 do
              if (Items[i+CopyOffs][a] is TFormulaRecord) then
                aRecordList.Add(Items[i+CopyOffs][a].CopyTo as TBaseRowColRecord);
          end else aRecordList.CopyFrom(Items[i+CopyOffs]);

          aRecordList.ArrangeCopyRows(MyDestRow);
        end;
        for z:= Count to MyDestRow-1 do Add(ListClass.Create);
        Insert(MyDestRow, aRecordList);
        aRecordList:=nil;
      finally
        FreeAndNil(aRecordList);
      end; //finally
      Inc(MyDestRow);
      if FirstRow>=DestRow then Inc(CopyOffs);
    end;

end;

procedure TBaseRowColList.SaveToStream(const DataStream: TStream);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveToStream(DataStream);
end;

function TBaseRowColList.TotalSize: int64;
var
  i:integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalSize;
end;

{ TCellList }
{$INCLUDE TCellListImp.inc}

constructor TCellList.Create(const aSST: TSST; const aRowRecordList: TRowRecordList; const aColInfoList: TColInfoList);
begin
  inherited Create(TCellRecordList);
  FSST:= aSST;
  FRowRecordList:=aRowRecordList;
  FColInfoList:=aColInfoList;
end;

function TCellList.GetValue(Row, Col: integer): TXlsCellValue;
var
  Index: integer;
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]);
  if Row>=Count then begin; Result.Value:=Unassigned; Result.XF:=-1; Result.IsFormula:=false; exit; end;
  if Items[Row].Find(Col,Index) then
  begin
    Result.Value:=Items[Row][Index].Value;
    Result.XF:=Items[Row][Index].XF;
    Result.IsFormula:=Items[Row][Index] is TFormulaRecord;
  end else
  begin
    Result.Value:=Unassigned;
    Result.XF:=-1;
    Result.IsFormula:=false;
  end;
end;

procedure TCellList.SetValue(Row, Col: integer; const Value: TXlsCellValue);
var
  Index: integer;
  XF, DefaultXF: integer;
  Found: boolean;
  Cell: TCellRecord;
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);

  DefaultXF:=FRowRecordList[Row].XF;
  if DefaultXF<=0 then if FColInfoList.Find(Col, Index) then DefaultXF:=FColInfoList[Index].XF;

  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;

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

    varByte,
    varSmallint,
    varInteger,
    varSingle,
    varDouble,
   {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} 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,FSST);

    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,FSST);

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

  if Found then Items[Row].Delete(Index);
  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;
  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 not ShrFmlas.Find(Key, Index) then raise Exception.Create(ErrShrFmlaNotFound);
  Formula.MixShared(ShrFmlas[Index].Data, ShrFmlas[Index].DataSize);
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.GetMaxCol(Row: integer): integer;
begin
  if (Row>=Count) or (Row<0) or (Items[Row].Count<=0)then begin; Result:=0; exit; end;
  Result:= Items[Row][Items[Row].Count-1].Column;

end;

{ TCells }

procedure TCells.AddCell(const aRecord: TCellRecord; const aRow: integer);
begin
  FCellList.AddRecord(aRecord, aRow);
end;

procedure TCells.AddMultipleCells(const aRecord: TMultipleValueRecord);
var
  OneRec: TCellRecord;
begin
  while not aRecord.Eof do
  begin
    OneRec:=aRecord.ExtractOneRecord;
    FCellList.AddRecord( OneRec, OneRec.Row);
  end;
end;

procedure TCells.AddRow(const aRecord: TRowRecord);
begin
  FRowList.AddRecord(aRecord);
end;

procedure TCells.ArrangeInsert(const InsPos, InsCount: integer;
  const SheetInfo: TSheetInfo);
begin
  FRowList.ArrangeInsert(InsPos, InsCount, SheetInfo);
  FCellList.ArrangeInsert(InsPos, InsCount, SheetInfo);
end;

procedure TCells.Clear;
begin
  if FRowList<>nil then FRowList.Clear;
  if FCellList<>nil then FCellList.Clear;
end;

procedure TCells.CopyFrom(const aList: TCells);
begin
  FRowList.CopyFrom(aList.FRowList);
  FCellList.CopyFrom(aList.FCellList);
end;

constructor TCells.Create(const aSST: TSST; const aColInfoList: TColInfoList);
begin
  inherited Create;
  FRowList:=TRowRecordList.Create;
  FCellList:=TCellList.Create(aSST, FRowList, aColInfoList);
end;

procedure TCells.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
begin
  FRowList.DeleteRows(aRow, aCount, SheetInfo);
  FCellList.DeleteRows(aRow, aCount, SheetInfo);
end;

destructor TCells.Destroy;
begin
  FreeAndNil(FRowList);
  FreeAndNil(FCellList);
  inherited;
end;

procedure TCells.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
  FRowList.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
  FCellList.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, OnlyFormulas);
end;

procedure TCells.SaveToStream(const DataStream: TStream);
var
  i,k,j, Written :integer;
begin
  if FRowList.Count< FCellList.Count then raise Exception.Create(ErrBadRowCount);
  if FRowList.Count=0 then exit;
  i:=0;
  while (i<FrowList.Count) do
  begin
    k:=0;Written:=0;
    while (Written<32) and (k+i<FRowList.Count) do
    begin
      if FRowList.HasRow(k+i) then
      begin
        FRowList[k+i].SaveToStream(DataStream);
        inc(Written);
      end;
      inc(k);
    end;

    for j:= i to k+i-1 do
      if (j<FCellList.Count) then FCellList[j].SaveToStream(DataStream);

    inc(i, k);
  end;

end;

function TCells.TotalSize: int64;
begin
  TotalSize:= FRowList.TotalSize + FCellList.TotalSize;
end;

{ TRangeList }

{$INCLUDE TRangeListImp.inc}

procedure TRangeList.CopyFrom(const aRangeList: TRangeList);
var
  i: integer;
begin
  for i:=0 to aRangeList.Count - 1 do
    Add(aRangeList.Items[i].CopyTo);
end;

procedure TRangeList.DeleteRows(const aRow, aCount: word;
  const SheetInfo: TSheetInfo);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].DeleteRows(aRow, aCount, SheetInfo);
end;

procedure TRangeList.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
end;

procedure TRangeList.SaveToStream(const DataStream: TStream);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveToStream(DataStream);
end;

function TRangeList.TotalSize: int64;
var
  i:integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalSize;
end;

end.