tmsuxlsrowcolentries.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

unit tmsUXlsRowColEntries;
{$INCLUDE ..\FLXCOMPILER.INC}
{$INCLUDE ..\FLXCONFIG.INC}

interface
uses Classes, SysUtils, tmsUXlsBaseRecords, tmsUXlsBaseRecordLists, tmsUXlsOtherRecords,
     tmsXlsMessages, tmsUXlsRangeRecords, tmsUXlsBaseList, tmsUXlsCellRecords, tmsUXlsFormula,
     {$IFDEF FLX_NEEDSVARIANTS} variants,{$ENDIF}
     {$IFDEF FLX_NEEDSTYPES} Types,{$ENDIF} //Delphi 6 or above
     tmsUXlsSST, tmsUFlxMessages, tmsUXlsColInfo, tmsUXlsReferences, tmsUXlsWorkbookGlobals, tmsUXlsTokenArray, tmsXlsFormulaMessages,tmsUFlxNumberFormat,
  {$IFDEF FLX_VCL}
    Graphics,
  {$ENDIF}
  {$IFDEF FLX_CLX}
    QGraphics,
  {$ENDIF}

   tmsUFlxFormats, tmsUOle2Impl;

type
  TListClass= class of TBaseRowColRecordList;

  TFlxFontArray = array of TFlxFont;
  TIntegerArray = array of integer;

  TColWidthCalc = class
  private
    XFFonts: TFlxFontArray;
    Wg: TWorkbookGlobals;
    bmp: TBitmap;
    Canvas: TCanvas;

    procedure InitXF();
  public
    constructor Create(const aWg: TWorkbookGlobals);
    function CalcCellWidth(const Row: integer; const Col: integer; const val: TRichString; const XF: integer; const Workbook: pointer; const RowMultDisplay: Extended; const ColMultDisplay: Extended): integer;
    destructor Destroy;override;
  end;


  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: TOle2File);
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);
    function TotalSize: int64;
    function TotalRangeSize(const CellRange: TXlsCellRange): int64;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure InsertAndCopyCols(const FirstCol, LastCol, DestCol, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean); virtual;
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
    procedure DeleteCols(const aCol, aCount: word; const SheetInfo: TSheetInfo);
    procedure ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo); virtual;

    constructor Create(const aListClass: TListClass);
  end;

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

    function GetValue(Row, Col: integer): TXlsCellValue;
    procedure FixFormulaTokens(const Formula: TFormulaRecord; const ShrFmlas: TShrFmlaRecordList);
    function GetFormula(Row, Col: integer): UTF16String;
    procedure SetFormula(Row, Col: integer; const Value: UTF16String);
    procedure AutofitColumn(const Workbook: pointer; const Column: integer;
      const ColCalc: TColWidthCalc; const RowMultDisplay,
      ColMultDisplay: Extended; const IgnoreStrings: Boolean;
      const Adjustment: Extended);

    {$INCLUDE TCellListHdr.inc}
  public
    constructor Create(const aGlobals: TWorkbookGlobals; const aRowRecordList: TRowRecordList; const aColInfoList: TColInfoList);
    property Value[Row,Col:integer]:TXlsCellValue  read GetValue;
    procedure SetValueX2(const Row, Col: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList; const Options1904: boolean);
    procedure GetValueX2(const Row, Col: integer; out V: TXlsCellValue; out RTFRuns: TRTFRunList);
    procedure SetFormat(const Row, Col: integer; const XF: integer);
    property Formula[Row,Col: integer]: UTF16String read GetFormula write SetFormula;
    procedure AssignFormulaX(const Row, Col: integer; const Formula: UTF16String; const Value: variant; const Options1904: boolean);
    function ArrayFormula(const Row, Col: integer): PArrayOfByte;
    function TableFormula(const Row, Col: integer): PArrayOfByte;
    procedure FixFormulas(const ShrFmlas: TShrFmlaRecordList);

    function GetSheetName(const SheetNumber: integer): UTF16String;
    function AddExternSheet(const FirstSheet, LastSheet: Integer): Integer;
    function FindSheet(SheetName: UTF16String; out SheetIndex: Integer): Boolean;

    procedure InsertAndCopyCols(const FirstCol, LastCol, DestCol, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean); override;
    procedure ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo); override;

    procedure ArrangeInsertSheet(const SheetInfo: TSheetInfo);
    function GetName(const ExternSheet, NameId: integer): UTF16String;

    procedure RecalcColWidths(const Workbook: pointer; const Col1, Col2: integer; const IgnoreStrings: boolean; const Adjustment: Extended);
    procedure RecalcRowHeights(const Workbook: pointer; const Row1, Row2: integer; const Forced, KeepAutofit: Boolean; const Adjustment: Extended);

    function FixTotalSize(const NeedsRecalc: boolean): int64;
  end;

  TCells = class
  private
    FRowList: TRowRecordList;
    FCellList: TCellList;
    procedure WriteDimensions(const DataStream: TOle2File; const CellRange: TXlsCellRange);
    function DimensionsSize: integer;
    procedure CalcUsedRange(var CellRange: TXlsCellRange);
    procedure ArrangeCols;
  public
    constructor Create(const aGlobals: TWorkbookGlobals; const aColInfoList: TColInfoList);
    destructor Destroy; override;

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

    procedure SaveToStream(const DataStream: TOle2File);
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);
    function TotalSize: int64;
    function FixTotalSize(const NeedsRecalc: boolean): int64;
    function TotalRangeSize(const CellRange: TXlsCellRange): int64;

    procedure FixRows;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure InsertAndCopyCols(const FirstCol, LastCol, DestCol, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
    procedure DeleteCols(const aCol, aCount: word; const SheetInfo: TSheetInfo);
    procedure ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
    procedure ArrangeInsertSheet(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: TOle2File);
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);
    function TotalSize: int64;
    function TotalRangeSize(const CellRange: TXlsCellRange): int64;

    procedure InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean);
    procedure DeleteRowsOrCols(const aRow, aCount: word; const SheetInfo: TSheetInfo; const UseCols: boolean);

  end;

implementation
uses tmsUXlsFormulaParser, tmsUXlsEncodeFormula, tmsUXlsXF, tmsUExcelAdapter
  ,Math;

{$INCLUDE TBaseRowColListImp.inc}
{$INCLUDE TRangeListImp.inc}
{$INCLUDE TCellListImp.inc}

type

  /// <summary>
  /// Class for calculating the automatic row heights.
  /// This is a tricky thing because we are coupling GDI calls with
  /// non-graphic code, but there is no other way to do it.
  /// </summary>
  TRowHeightCalc = class
  private
    XFHeight: TIntegerArray;
    XFFonts: TFlxFontArray;
    Wg: TWorkbookGlobals;
    Canvas: TCanvas;
    bmp: TBitmap;

    procedure InitXF();
  public
    constructor Create(const aWg: TWorkbookGlobals);
    destructor Destroy;override;
    function CalcCellHeight(const Row: integer; const Col: integer; const val: TRichString; const XF: integer; const Workbook: pointer; const RowMultDisplay: Extended; const ColMultDisplay: Extended): integer;
  end;

{ TBaseRowColList }
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.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].ArrangeInsertRowsAndCols(InsRowPos, InsRowCount,InsColPos,InsColCount, 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
  ArrangeInsertRowsAndCols(aRow, -aCount, 0, 0, SheetInfo);

end;

procedure TBaseRowColList.DeleteCols(const aCol, aCount: word; const SheetInfo: TSheetInfo);
var
  Index: integer;
  r,c: integer;
begin
  for r:=0 to Count-1 do
    for c:= aCol to ACol+aCount-1 do
      if Items[r].Find(c, Index) then Items[r].Delete(Index);
  //Delete the cells. we have to look at all the formulas, not only those below arow
  ArrangeInsertRowsAndCols(0, 0, aCol, -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
  ArrangeInsertRowsAndCols(DestRow, aCount*(LastRow-FirstRow+1), 0,0, 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
        //Will only copy the cells if copyfrom < recordcount. This allows us to only insert, and not copy.
        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]);

          if (aRecordList.Count>0) then aRecordList.ArrangeCopyRowsAndCols(MyDestRow-aRecordList[0].Row,0);
        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.InsertAndCopyCols(const FirstCol, LastCol, DestCol,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
var
  i, k, r, CopyOffs, MyDestCol: integer;
  Index: integer;
  Rec: TBaseRowColRecord;
begin
  // Insert the cells. we have to look at all the formulas, not only those at the left from destcol
  ArrangeInsertRowsAndCols(0,0,DestCol, aCount*(LastCol-FirstCol+1), SheetInfo);

  //Copy the cells
  MyDestCol:=DestCol;
  if (DestCol<=FirstCol) then CopyOffs:=aCount*(LastCol-FirstCol+1) else CopyOffs:=0;

  for k:=1 to aCount do
    for i:=FirstCol to LastCol do
    begin
      for r:=0 to Count-1 do
      begin
        if Items[r].Find(i+CopyOffs, Index)
          and  ( not OnlyFormulas or (Items[r][Index] is TFormulaRecord)) then
          begin
            Rec:=(Items[r][Index].CopyTo as TBaseRowColRecord);
            try
              Rec.ArrangeCopyRowsAndCols(0,MyDestCol-Rec.Column);
            except
              FreeAndNil(Rec);
              raise;
            end; //except
            Items[r].Find(Rec.Column, Index);
            Items[r].Insert(Index, Rec);
          end;

      end;
      Inc(MyDestCol);
    end;
end;

procedure TBaseRowColList.SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveRangeToStream(DataStream, CellRange);
end;

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

function TBaseRowColList.TotalRangeSize(const CellRange: TXlsCellRange): int64;
var
  i: integer;
begin
  Result:=0;
  for i:=CellRange.Top to CellRange.Bottom do Result:=Result+Items[i].TotalRangeSize(CellRange, false);
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 }

constructor TCellList.Create(const aGlobals: TWorkbookGlobals; const aRowRecordList: TRowRecordList; const aColInfoList: TColInfoList);
begin
  inherited Create(TCellRecordList);
  FGlobals:= aGlobals;
  FRowRecordList:=aRowRecordList;
  FColInfoList:=aColInfoList;
end;

procedure TCellList.GetValueX2(const Row, Col: integer;
  out V: TXlsCellValue; out RTFRuns: TRTFRunList);
var
  Index: 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]);
  SetLength(RTFRuns,0);
  if Row>=Count then begin; V.Value:=Unassigned; V.XF:=-1; V.IsFormula:=false; exit; end;
  if Items[Row].Find(Col,Index) then
  begin
    V.XF:=Items[Row][Index].XF;
    V.IsFormula:=Items[Row][Index] is TFormulaRecord;
    if Items[Row][Index] is TLabelSSTRecord then
    begin
      Rs:=(Items[Row][Index] as TLabelSSTRecord).AsRichString;
      V.Value:=Rs.Value;
      RTFRuns:= Copy(Rs.RTFRuns);
    end else
    if Items[Row][Index] is TRStringRecord then
    begin
      Rs:=(Items[Row][Index] as TRStringRecord).AsRichString;
      V.Value:=Rs.Value;
      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.SetValueX2(const Row, Col: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList; const Options1904: boolean);
var
  Index, k: integer;
  XF, DefaultXF: integer;
  Found: boolean;
  Cell: TCellRecord;
  ValueType: integer;
  Rs: TRichString;
  RealValue: variant;
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;


  RealValue:= Value.Value;
  ValueType:= VarType(RealValue);

  {$IFDEF FLX_HASCUSTOMVARIANTS}
  //Check for Custom Variants
  if (ValueType>=$010F) and (ValueType<=$0FFF) then
  begin