tmsuexcelrecords.pas

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

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

interface
uses SysUtils, Contnrs, Classes, tmsXlsMessages, tmsUXlsBaseRecords, tmsUXlsBaseRecordLists,
     tmsUXlsOtherRecords, tmsUXlsSST, tmsUXlsReferences, tmsUSheetNameList, tmsUXlsFormula,
     tmsUXlsEscher, tmsUXlsClientData, tmsUXlsSheet, tmsUXlsWorkbookGlobals, tmsUXlsBaseList, tmsUFlxMessages,
     tmsUOle2Impl;

type

  TSheetList = class(TBaseList) //records are TSheet
    {$INCLUDE TSheetListHdr.inc}
    procedure SaveToStream(const DataStream: TOle2File);
    procedure InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount: integer; SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
    procedure DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word; SheetInfo: TSheetInfo);
    procedure DeleteSheets(const SheetIndex: integer; const SheetCount: integer);
  end;

  TWorkbook = class
  private
    FGlobals: TWorkbookGlobals;
    FSheets: TSheetList;

    procedure FixBoundSheetsOffset(const NeedsRecalc: boolean);
    procedure FixRows;
    function GetWorkSheets(index: integer): TWorksheet;
    function GetActiveSheet: integer;
    procedure SetActiveSheet(const Value: integer);
    procedure FixRangeBoundSheetsOffset(const SheetIndex: integer; const CellRange: TXlsCellRange; const NeedsRecalc: boolean);
    procedure FixCodeNames;
    function GetIsXltTemplate: boolean;
    procedure SetIsXltTemplate(const Value: boolean);
  public
    property Globals: TWorkbookGlobals read FGlobals write FGlobals;
    property Sheets: TSheetList read FSheets write FSheets;

    function IsWorksheet(const Index: integer): boolean;
    property WorkSheets[index:integer]: TWorksheet read GetWorkSheets;

    property IsXltTemplate: boolean read GetIsXltTemplate write SetIsXltTemplate;

    property ActiveSheet: integer read GetActiveSheet write SetActiveSheet;

    constructor Create;
    destructor Destroy;override;

    procedure LoadFromStream( const DataStream: TOle2File);
    procedure SaveToStream(const DataStream: TOle2File; const NeedsRecalc: boolean);
    procedure SaveRangeToStream(const DataStream: TOle2File; const SheetIndex: integer; const CellRange: TXlsCellRange; const NeedsRecalc: boolean);

    //Manipulating Methods
    procedure InsertAndCopyRowsAndCols(const SheetNo, FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount: integer; const OnlyFormulas: boolean);
    procedure DeleteRowsAndCols(const SheetNo: integer; const aRow, aRowCount, aCol, aColCount: word);
    procedure InsertSheets(const CopyFrom, InsertBefore: integer; SheetCount: integer);
    procedure DeleteSheets(const SheetPos, SheetCount: integer);

    procedure InsertHPageBreak(const SheetNo: integer; const aRow: word);
    procedure InsertVPageBreak(const SheetNo: integer; const aCol: word);

    procedure RestoreObjectCoords(dSheet: integer);
  end;

implementation

{ TSheetList }
{$INCLUDE TSheetListImp.inc}

procedure TSheetList.InsertAndCopyRowsAndCols(const FirstRow, LastRow,
  DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount: integer; SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
var
  i:integer;
begin
  Items[SheetInfo.InsSheet].InsertAndCopyRowsAndCols(FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount, SheetInfo, OnlyFormulas);
  for i:=0 to Count -1 do if i<>SheetInfo.InsSheet then
  begin
    SheetInfo.FormulaSheet:=i;
    Items[i].ArrangeInsertRowsAndCols(DestRow, (LastRow-FirstRow+1)*aRowCount, DestCol, (LastCol-FirstCol+1)*aColCount, SheetInfo);
  end;
end;

procedure TSheetList.DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word;
  SheetInfo: TSheetInfo);
var
  i:integer;
begin
  Items[SheetInfo.InsSheet].DeleteRowsAndCols(aRow, aRowCount, aCol, aColCount, SheetInfo);
  for i:=0 to Count -1 do if i<>SheetInfo.InsSheet then
  begin
    SheetInfo.FormulaSheet:=i;
    Items[i].ArrangeInsertRowsAndCols(aRow, -aRowCount, aCol, -aColCount, SheetInfo);
  end;
end;

procedure TSheetList.DeleteSheets(const SheetIndex, SheetCount: integer);
var
  i: integer;
begin
  for i:=0 to SheetCount-1 do
  begin
    if (SheetIndex>= Count) then exit;
    if (Items[SheetIndex] is TWorkSheet) then (Items[SheetIndex] as TWorkSheet).Clear;  //Images are not cleared when destroyng. thats why we need to clear.
    Delete(SheetIndex);
  end;
end;

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

{ TWorkbook }

constructor TWorkbook.Create;
begin
  inherited;
  FGlobals:= TWorkbookGlobals.Create;
  FSheets := TSheetList.Create;
end;

procedure TWorkbook.DeleteRowsAndCols(const SheetNo: integer; const aRow, aRowCount, aCol, aColCount: word);
var
  SheetInfo: TSheetInfo;
begin
  if(SheetNo>= Sheets.Count) then raise Exception.CreateFmt(ErrInvalidSheetNo, [SheetNo, 0, Sheets.Count-1]);

  SheetInfo.InsSheet:=SheetNo;
  SheetInfo.FormulaSheet:=SheetNo;
  SheetInfo.GetSheet:=Globals.References.GetSheet;
  SheetInfo.SetSheet:=Globals.References.SetSheet;
  SheetInfo.Names:=nil;

  FSheets.DeleteRowsAndCols(aRow, aRowCount, aCol, aColCount, SheetInfo);
  Globals.DeleteRowsAndCols(aRow, aRowCount, aCol, aColCount, SheetInfo);
end;

  //PENDING: DVal (data validation)
  //PENDING: HLINKS // SCREENTIP
  //PENDING: LabelRanges
  //MADE: TABLE
  //PENDING: Index /dbcell
  //PENDING: property LoadValuesOnly
  //PENDING: String records    Ver como arreglamos esto y dbcells
  //MADE: Dimensions
  //PENDING: eliminar mensaje excel grabado con version anterior
destructor TWorkbook.Destroy;
begin
  FreeAndNil(FSheets);
  //Order is important. Globals should be freed after sheets
  FreeAndNil(FGlobals);
  inherited;
end;

procedure TWorkbook.FixRangeBoundSheetsOffset(const SheetIndex: integer; const CellRange: TXlsCellRange; const NeedsRecalc: boolean);
var
  TotalOfs: int64;
begin
  Globals.SST.FixRefs;
  TotalOfs:=Globals.TotalRangeSize(SheetIndex, CellRange);  //Includes the EOF on workbook Globals
  if Globals.SheetCount<> Sheets.Count then raise Exception.Create(ErrExcelInvalid);

  Sheets[SheetIndex].FixTotalSize(NeedsRecalc); 
  Globals.SheetSetOffset(SheetIndex, TotalOfs);
end;

procedure TWorkbook.FixBoundSheetsOffset(const NeedsRecalc: boolean);
var
  i: integer;
  TotalOfs: int64;
begin
  Globals.SST.FixRefs;
  TotalOfs:=Globals.TotalSize;  //Includes the EOF on workbook Globals
  if Globals.SheetCount<> Sheets.Count then raise Exception.Create(ErrExcelInvalid);

  for i:=0 to Globals.SheetCount-1 do
  begin
    Globals.SheetSetOffset(i,TotalOfs);
    TotalOfs:=TotalOfs+(Sheets[i].FixTotalSize(NeedsRecalc));
  end;
end;

procedure TWorkbook.FixRows;
var
  i: integer;
begin
  for i:=0 to Globals.SheetCount-1 do
  begin
    Sheets[i].FixRows;
  end;
end;

function TWorkbook.GetActiveSheet: integer;
begin
  Result:= Globals.ActiveSheet;
end;


function TWorkbook.GetIsXltTemplate: boolean;
begin
  Result := FGlobals.IsXltTemplate;
end;

function TWorkbook.GetWorkSheets(index: integer): TWorksheet;
begin
  Result:= Sheets[index] as TWorkSheet;
end;

procedure TWorkbook.InsertAndCopyRowsAndCols(const SheetNo, FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount: integer; const OnlyFormulas: boolean);
var
  SheetInfo: TSheetInfo;
begin
  //Some error handling
  if (FirstRow>LastRow) or (FirstRow<0) or (LastRow> Max_Rows) or
  ((FirstRow<DestRow) and (DestRow<=LastRow)) or (DestRow+(LastRow-FirstRow+1)*aRowCount>Max_Rows)
  or (DestRow<0)
  then raise Exception.Create(ErrBadCopyRows);   

  if (FirstCol>LastCol) or (FirstCol<0) or (LastCol> Max_Columns) or
  ((FirstCol<DestCol) and (DestCol<=LastCol)) or (DestCol+(LastCol-FirstCol+1)*aColCount>Max_Columns)
  or (DestCol<0)