tmsuxlsbaserecordlists.pas

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

unit tmsUXlsBaseRecordLists;
{$INCLUDE ..\FLXCOMPILER.INC}

interface
uses SysUtils, Contnrs, Classes, tmsXlsMessages,
     tmsUXlsBaseRecords, tmsUXlsOtherRecords, tmsUXlsFormula, tmsUXlsBaseList,
     tmsUFlxMessages, tmsUOle2Impl;

type

  TBaseRecordList = class(TBaseList) //Records are TBaseRecord
    {$INCLUDE TBaseRecordListHdr.inc}
  private
    FTotalSize: int64;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification);override;
    function GetTotalSize: int64; virtual;
  public
    procedure AdaptSize(Delta: integer);

    procedure CopyFrom(const aBaseRecordList: TBaseRecordList);
    property TotalSize: int64 read GetTotalSize;
    procedure SaveToStream(const DataStream: TOle2File); virtual;
  end;

  TBaseRowColRecordList = class(TBaseRecordList) //Records are TBaseRowColRecord
    {$INCLUDE TBaseRowColRecordListHdr.inc}
    procedure ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);
    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo);
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);virtual;

    function TotalRangeSize(const CellRange: TXlsCellRange; const NeedsRecalc: boolean): int64;virtual;
  end;

  TNameRecordList = class(TBaseRecordList) //Records are TNameRecord
    {$INCLUDE TNameRecordListHdr.inc}
    procedure ArrangeInsertRowsAndCols(const InsRow, aRowCount, InsCol, aColCount: integer; const SheetInfo: TSheetInfo);
    procedure InsertSheets(const CopyFrom, BeforeSheet:integer;  SheetCount: integer; SheetInfo: TSheetInfo);
    procedure DeleteSheets(const SheetIndex, SheetCount: integer);
  end;

  TBoundSheetRecordList = class (TBaseRecordList)
  private
    function GetSheetName(index: integer): UTF16String;
    procedure SetSheetName(index: integer; const Value: UTF16String);
    function GetSheetVisible(index: integer): TXlsSheetVisible;
    procedure SetSheetVisible(index: integer; const Value: TXlsSheetVisible);
  public
    {$INCLUDE TBoundSheetRecordListHdr.inc}
    property SheetName[index: integer]: UTF16String read GetSheetName write SetSheetName;
    property SheetVisible[index: integer]: TXlsSheetVisible read GetSheetVisible write SetSheetVisible;
  end;

  TCellRecordList = class (TBaseRowColRecordList)
    {$INCLUDE TCellRecordListHdr.inc}

    private
      procedure GoNext(var i: integer; const aCount: integer; var it: TCellRecord; var NextRec: TCellRecord);
    function SaveAndCalcRange(const DataStream: TOle2File;
      const CellRange: TXlsCellRange; const NeedsRecalc: boolean): int64;
    public
      procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange); override;
      function TotalRangeSize(const CellRange: TXlsCellRange; const NeedsRecalc: boolean): int64; override;
      procedure SaveToStream(const DataStream: TOle2File); override;
      function GetTotalSize: int64;override;
      function FixTotalSize(const NeedsRecalc: boolean): int64;

  end;

  TRowRecordList = class (TBaseRowColRecordList)
  private
    function GetItems(index: integer): TRowRecord;
    procedure SetItems(index: integer; const Value: TRowRecord);
  public
    function AddRecord(aRecord: TRowRecord): integer;
    property Items[index: integer]: TRowRecord read GetItems write SetItems; default;
    function HasRow(const Index: integer): boolean;
    procedure AddRow(const Index: word);
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo);
    procedure DeleteRows(const aRow, aRowCount: word; const SheetInfo: TSheetInfo);

    function RowHeight(const aRow: integer): integer;
    procedure SetRowHeight(const aRow: integer; const Height: word);

    procedure AutoRowHeight(const aRow: integer; const Value: boolean);
    function IsAutoRowHeight(const aRow: integer): boolean;

    function TotalRangeSize(const CellRange: TXlsCellRange; const NeedsRecalc: boolean): int64; override;

    procedure CalcGuts(const Guts: TGutsRecord);
  end;

  TShrFmlaRecordList=class(TBaseRecordList)
    {$INCLUDE TShrFmlaRecordListHdr.inc}
  end;

implementation
{$INCLUDE TShrFmlaRecordListImp.inc}
{$INCLUDE TBaseRecordListImp.inc}
{$INCLUDE TBaseRowColRecordListImp.inc}
{$INCLUDE TNameRecordListImp.inc}
{$INCLUDE TBoundSheetRecordListImp.inc}
{$INCLUDE TCellRecordListImp.inc}


{ TBaseRecordList }

procedure TBaseRecordList.AdaptSize(Delta: integer);
begin
  Inc(FTotalSize, Delta);
end;

procedure TBaseRecordList.SaveToStream(const DataStream: TOle2File);
var
  i:integer;
  it: TBaseRecord;
begin
  for i:=0 to Count-1 do
  begin
    it:=(Items[i] as TBaseRecord);
    if it<>nil then it.SaveToStream(DataStream);
  end;
end;

procedure TBaseRecordList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  if Ptr<>nil then
  begin
    if Action = lnDeleted then FTotalSize:= FTotalSize-TBaseRecord(Ptr).TotalSize;
    if Action = lnAdded then FTotalSize:= FTotalSize+TBaseRecord(Ptr).TotalSize;
  end;
  inherited Notify(Ptr, Action);
end;

procedure TBaseRecordList.CopyFrom(const aBaseRecordList: TBaseRecordList);
var
  i:integer;
begin
  if aBaseRecordList=nil then exit;
  for i:=0 to aBaseRecordList.Count-1 do Add((aBaseRecordList[i] as TBaseRecord).CopyTo);
end;

function TBaseRecordList.GetTotalSize: int64;
begin
  Result:= FTotalSize;
end;

{ TBaseRowColRecordList }
procedure TBaseRowColRecordList.ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);
var
  i: integer;
  it: TBaseRowColRecord;
begin
  for i:=0 to Count-1 do
  begin
    it:= Items[i];
    if it<>nil then it.ArrangeCopyRowsAndCols(RowOffset, ColOffset);
  end;
end;

procedure TBaseRowColRecordList.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo);
var
  i: integer;
  it: TBaseRowColRecord;
begin
  for i:=0 to Count-1 do
  begin
    it:=Items[i];
    if it<>nil then it.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount, SheetInfo);
  end;
end;

procedure TBaseRowColRecordList.SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);
var
  i, r, c:integer;
  it: TBaseRowColRecord;
begin
  for i:=0 to Count-1 do
  begin
    it:=(Items[i] as TBaseRowColRecord);
    if (it<>nil) then
    begin
      r:=it.Row;c:=it.Column;
      if  (r>=CellRange.Top) and (r<=CellRange.Bottom)
         and (c>=CellRange.Left) and (c<=CellRange.Right) then
           it.SaveToStream(DataStream);
    end;
  end;
end;

function TBaseRowColRecordList.TotalRangeSize(const CellRange: TXlsCellRange; const NeedsRecalc: boolean): int64;
var
  i:integer;
  it: TBaseRowColRecord;
begin
  Result:=0;
  for i:=0 to Count-1 do
  begin
    it:=(Items[i] as TBaseRowColRecord);
    if (it<>nil)and (it.Row>=CellRange.Top) and (it.Row<=CellRange.Bottom)
       and (it.Column>=CellRange.Left) and (it.Column<=CellRange.Right) then
       Result:=Result+it.FixTotalSize(NeedsRecalc);
  end;
end;


{ TNameRecordList }

procedure TNameRecordList.ArrangeInsertRowsAndCols(const InsRow, aRowCount, InsCol, aColCount: integer; const SheetInfo: TSheetInfo);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].ArrangeInsertRowsAndCols(InsRow, aRowCount, InsCol, aColCount, SheetInfo);
end;

procedure TNameRecordList.DeleteSheets(const SheetIndex,
  SheetCount: integer);
var
  i: integer;
begin
  for i:=Count-1 downto 0 do
  begin
    if (Items[i].RangeSheet>=SheetIndex) and (Items[i].RangeSheet<SheetIndex+SheetCount) then
      Delete(i)
    else
      Items[i].ArrangeInsertSheets(SheetIndex, -SheetCount);
  end;
end;

procedure TNameRecordList.InsertSheets(const CopyFrom, BeforeSheet:integer;
  SheetCount: integer; SheetInfo: TSheetInfo);
var
  i, k, MyCount: integer;
begin
  MyCount:=Count;
  for i:=0 to MyCount-1 do
  begin
    if (CopyFrom>=0) and
    (
      (Items[i].RangeSheet=CopyFrom) or
      ((Items[i].RangeSheet=-1) and (Items[i].RefersToSheet(SheetInfo.GetSheet)=SheetInfo.FormulaSheet))
    )then
    begin
       for k:=0 to SheetCount-1 do
       begin
         SheetInfo.InsSheet:=BeforeSheet+k;
         Add((Items[i].CopyTo as TNameRecord).ArrangeCopySheet(SheetInfo));
       end;
    end;

    Items[i].ArrangeInsertSheets(BeforeSheet, SheetCount);
  end;
end;


{ TRowRecordList }
function TRowRecordList.AddRecord(aRecord: TRowRecord):integer;
var
  i:integer;
begin
  if aRecord.GetRow<Count then
  begin
    if inherited Items[aRecord.GetRow]=nil then Items[aRecord.GetRow]:=aRecord else Raise Exception.Create(ErrDupRow);
    Result:= aRecord.GetRow;
  end
  else
  begin
    for i:=Count to aRecord.GetRow-1 do inherited Add(nil);
    Result:=inherited Add(aRecord);
  end;
end;

function TRowRecordList.GetItems(index: integer): TRowRecord;
begin
  Result := inherited Items[Index] as TRowRecord;