uxlsworkbookglobals.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 446 行 · 第 1/2 页

unit UXlsWorkbookGlobals;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}

interface
uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords, UXlsChart,
     UXlsSST, XlsMessages, UXlsSections, UXlsReferences, USheetNameList, UXlsEscher,
     UXlsFormula, UEscherRecords, UXlsPalette, UXlsXF, UFlxMessages;
type
  TBoundSheetList = class
  private
   FSheetNames: TSheetNameList;  //Cache with all the sheet names to speed up searching
   FBoundSheets: TBoundSheetRecordList;
  public
    property BoundSheets: TBoundSheetRecordList read FBoundSheets;

    constructor Create;
    destructor Destroy; override;
    procedure Clear;

    procedure Add(const aRecord: TBoundSheetRecord);

    procedure SaveToStream(const DataStream: TStream);
    procedure SaveRangeToStream(const DataStream: TStream; const SheetIndex: integer);
    function TotalSize:int64;
    function TotalRangeSize(const SheetIndex: integer): int64;

    procedure InsertSheet(const BeforeSheet: integer; const OptionFlags: word; const SheetName: WideString);
    procedure DeleteSheet(const SheetIndex: integer);
  end;

  TWorkbookGlobals = class( TBaseSection)
  private
    FSST: TSST;
    FReferences: TReferences;
    FBoundSheets: TBoundSheetList;
    FMiscRecords: TBaseRecordList;
    FNames : TNameRecordList;
    FDrawingGroup: TDrawingGroup;
    FWindow1: TWindow1Record;
    FXF: TXFRecordList;
    FFonts: TFontRecordList;
    FFormats: TFormatRecordList;

    FPaletteCache: TPaletteRecord;
    FPaletteIndex: integer;

    FHasMacro: boolean;
    FCodeName: WideString;

    function GetSheetCount: integer;
    function GetSheetName(const index: integer): Widestring;
    procedure SetSheetName(const index: integer; const Value: Widestring);
    function GetSheetVisible(const index: integer): TXlsSheetVisible;
    procedure SetSheetVisible(const index: integer; const Value: TXlsSheetVisible);
    function GetSheetOptionFlags(const index: integer): word;
    function GetActivesheet: integer;
    procedure SetActiveSheet(const Value: integer);
    function GetColorPalette(Index: integer): LongWord;
    procedure SetColorPalette(Index: integer; const Value: LongWord);
  public
    property SST: TSST read FSST;

    property SheetName[const index: integer]: Widestring read GetSheetName write SetSheetName;
    procedure SetFirstSheetVisible(const index: integer);
    property SheetVisible[const index: integer]: TXlsSheetVisible read GetSheetVisible write SetSheetVisible;
    property SheetCount: integer read GetSheetCount;
    property SheetOptionFlags[const index: integer]: word read GetSheetOptionFlags;
    procedure SheetSetOffset(const index: integer; const Offset: cardinal);

    property ActiveSheet: integer read GetActivesheet write SetActiveSheet;

    property DrawingGroup: TDrawingGroup read FDrawingGroup;
    property References: TReferences read FReferences;
    property Names: TNameRecordList read FNames;

    property HasMacro: boolean read FHasMacro;
    property CodeName: widestring read FCodeName;

    constructor Create;
    destructor Destroy; override;
    function TotalSize:int64; override;
    function TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64; override;
    procedure Clear; override;
    procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST); override;
    procedure SaveToStream(const DataStream: TStream);override;
    procedure SaveRangeToStream(const DataStream: TStream; const SheetIndex: integer; const CellRange: TXlsCellRange);override;

    procedure InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount: integer; const SheetInfo: TSheetInfo);
    procedure DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word;const SheetInfo: TSheetInfo);

    procedure DeleteSheets(const SheetIndex, SheetCount: integer);
    procedure InsertSheets(const CopyFrom: integer; BeforeSheet: integer; const OptionFlags: word; const Name: WideString; const SheetCount: byte);

    property ColorPalette[Index: integer]: LongWord read GetColorPalette write SetColorPalette;

    property XF:TXFRecordList read FXF;
    property Fonts:TFontRecordList read FFonts;
    property Formats:TFormatRecordList read FFormats;
  end;


implementation
{ TBoundSheetList }

procedure TBoundSheetList.Add(const aRecord: TBoundSheetRecord);
begin
  FSheetNames.Add(aRecord.SheetName);
  FBoundSheets.Add(aRecord); //Last
end;

procedure TBoundSheetList.Clear;
begin
  if FSheetNames<>nil then FSheetNames.Clear;
  if FBoundSheets<>nil then FBoundSheets.Clear;
end;

procedure TBoundSheetList.DeleteSheet(const SheetIndex: integer);
begin
  FSheetNames.DeleteSheet(FBoundSheets.SheetName[SheetIndex]);
  FBoundSheets.Delete(SheetIndex);
end;

constructor TBoundSheetList.Create;
begin
  inherited;
  FSheetNames:= TSheetNameList.Create;
  FBoundSheets:= TBoundSheetRecordList.Create;
end;

destructor TBoundSheetList.Destroy;
begin
  FreeAndNil(FSheetNames);
  FreeAndNil(FBoundSheets);
  inherited;
end;

procedure TBoundSheetList.InsertSheet(const BeforeSheet: integer;
  const OptionFlags: word; const SheetName: WideString);
var
  NewName: WideString;
begin
  NewName:= FSheetNames.AddUniqueName(SheetName);
  FBoundSheets.Insert(BeforeSheet, TBoundSheetRecord.CreateNew(OptionFlags, NewName));
end;

procedure TBoundSheetList.SaveRangeToStream(const DataStream: TStream; const SheetIndex: integer);
begin
  if (SheetIndex>=FBoundSheets.Count)or (SheetIndex<0) then raise Exception.CreateFmt(ErrInvalidSheetNo, [SheetIndex,0,FBoundSheets.Count-1]);
  FBoundSheets[SheetIndex].SaveToStream(DataStream);
end;

procedure TBoundSheetList.SaveToStream(const DataStream: TStream);
begin
  FBoundSheets.SaveToStream(DataStream);
end;

function TBoundSheetList.TotalSize: int64;
begin
  TotalSize:= FBoundSheets.TotalSize;
end;

function TBoundSheetList.TotalRangeSize(const SheetIndex: integer): int64;
begin
  if (SheetIndex>=FBoundSheets.Count)or (SheetIndex<0) then raise Exception.CreateFmt(ErrInvalidSheetNo, [SheetIndex,0,FBoundSheets.Count-1]);
  Result:=FBoundSheets[SheetIndex].TotalSize;
end;

{ TWorkbookGlobals }

procedure TWorkbookGlobals.Clear;
begin
  inherited;
  if FSST<>nil then FSST.Clear;
  if FReferences<>nil then FReferences.Clear;
  if FBoundSheets<>nil then FBoundSheets.Clear;
  if FMiscRecords<>nil then FMiscRecords.Clear;
  if FNames<>nil then FNames.Clear;
  if FDrawingGroup<>nil then FDrawingGroup.Clear;
  if FXF<>nil then FXF.Clear;
  if FFonts<>nil then FFonts.Clear;
  if FFormats<>nil then FFormats.Clear;
  FPaletteCache:=nil;
  FWindow1:=nil;
  FHasMacro:=false;
  FCodeName:='';
end;

constructor TWorkbookGlobals.Create;
begin
  inherited;
  FSST:= TSST.Create;
  FReferences:= TReferences.Create;
  FBoundSheets:= TBoundSheetList.Create;
  FMiscRecords:= TBaseRecordList.Create;
  FNames:=TNameRecordList.Create;
  FDrawingGroup:= TDrawingGroup.Create;
  FXF:= TXFRecordList.Create;
  FFonts:= TFontRecordList.Create;
  FFormats:= TFormatRecordList.Create;
  FPaletteCache:=nil;
  FWindow1:=nil;
  FHasMacro:=false;
  FCodeName:='';
end;

procedure TWorkbookGlobals.DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word; const SheetInfo: TSheetInfo);
begin
  FNames.ArrangeInsertRowsAndCols(aRow, -aRowCount, aCol, -aColCount, SheetInfo);
end;

procedure TWorkbookGlobals.DeleteSheets(const SheetIndex,
  SheetCount: integer);
var
  i: integer;
begin
  if HasMacro then raise Exception.Create(ErrCantDeleteSheetWithMacros);  //If we delete a sheet that has a corresponding macro on the vba stream, Excel 2000 will crash when opening the file. Excel Xp seems to handle this ok.
  for i:=0 to SheetCount-1 do
      FBoundSheets.DeleteSheet(SheetIndex);
  FReferences.InsertSheets(SheetIndex, -SheetCount);
  FNames.DeleteSheets(SheetIndex, SheetCount);
end;

destructor TWorkbookGlobals.Destroy;