tmsuxlsescher.pas

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

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

interface
uses tmsUXlsBaseRecords, tmsUXlsBaseRecordLists, tmsUXlsOtherRecords,
     tmsXlsMessages, tmsUFlxMessages, Classes, SysUtils, tmsUEscherRecords, tmsUXlsSST, tmsUBreakList,
     tmsUEscherOtherRecords, tmsUOle2Impl;

type

  TXlsEscherRecord = class (TBaseRecord)
  end;

  TDrawingGroupRecord = class (TXlsEscherRecord)
  end;

  TDrawingRecord = class (TXlsEscherRecord)
  end;


  TDrawingSelectionRecord = class (TXlsEscherRecord)
  end;

  TDrawingGroup= class
  private
    FDggContainer: TEscherContainerRecord;
    FRecordCache: TEscherDwgGroupCache;
    function GetRecordCache: PEscherDwgGroupCache;
  public
    property  RecordCache: PEscherDwgGroupCache read GetRecordCache;

    constructor Create;
    procedure Clear;
    destructor Destroy; override;
    procedure LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const First: TDrawingGroupRecord);
    procedure SaveToStream(const DataStream: TOle2File);
    function TotalSize: int64;

    procedure AddDwg;
    procedure EnsureDwgGroup;
  end;

  TDrawing=class
  private
    FDgContainer: TEscherContainerRecord;
    FRecordCache: TEscherDwgCache;
    FDrawingGroup: TDrawingGroup;
    function GetDrawingName(index: integer): UTF16String;
    function GetDrawingRow(index: integer): integer;
    procedure CreateBasicDrawingInfo;

  public
    procedure Clear;
    constructor Create(const aDrawingGroup: TDrawingGroup);
    destructor Destroy; override;

    procedure CopyFrom(const aDrawing: TDrawing; const dSheet: TObject);
    procedure LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const First: TDrawingRecord; const SST: TSST);
    procedure SaveToStream(const DataStream: TOle2File);
    function TotalSize: int64;

    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo; const dSheet: TObject);
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo);
    procedure InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, RowCount, FirstCol, LastCol, DestCol, ColCount: integer; const SheetInfo: TSheetInfo; const dSheet: TObject);
    procedure DeleteRows(const aRow, aCount: word;const SheetInfo: TSheetInfo; const dSheet: TObject);
    procedure DeleteCols(const aCol, aCount: word;const SheetInfo: TSheetInfo; const dSheet: TObject);

    function FindObjId(const ObjId: word): TEscherClientDataRecord;

    function DrawingCount: integer;
    procedure AssignDrawing(const Index: integer; const Data: ByteArray; const DataType: TXlsImgTypes);
    function GetAnchor(const Index: integer): TClientAnchor;
    procedure SetAnchor(const Index: integer; const aAnchor: TClientAnchor; const sSheet: TObject);
    procedure GetDrawingFromStream(const Index: integer; const Data: TStream; out DataType: TXlsImgTypes);
    property DrawingRow[index: integer]: integer read GetDrawingRow;
    property DrawingName[index: integer]: UTF16String read GetDrawingName;

    procedure DeleteImage(const Index: integer);
    procedure ClearImage(const Index: integer);
    procedure AddImage(Data: ByteArray; DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType; const sSheet: TObject);

    procedure RemoveAutoFilter();
    procedure AddAutoFilter(const Row: Int32; const Col1: Int32; const Col2: Int32; const sSheet: TObject);overload;
    procedure AddAutoFilter(const Row: Int32; const Col: Int32; const sSheet: TObject);overload;

    function AddNewComment(const Properties: TImageProperties; const sSheet: TObject): TEscherClientDataRecord;

    procedure SaveObjectCoords(const sSheet: TObject);
    procedure RestoreObjectCoords(const dSheet: TObject);
  end;

implementation
uses tmsUXlsBaseClientData, tmsUXlsClientData;
const
  StEmptyBmp: Array[0..53] of byte = ($28,$0,$0,$0,$1,$0
            ,$0,$0,$1,$0,$0,$0,$1,$0,$1,$0,$0,$0,$0,$0,$0,$0,$0,$0,$12,$B,$0
            ,$0,$12,$B,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$FF,$FF,$FF,$0,$0,$0
            ,$0,$0,$0,$0,$0,$0,$0,$0);

function EmptyBmp: ByteArray;
var
  i : integer;
begin
  SetLength (result, Length (StEmptyBmp));
  for i := 0 to High (StEmptyBmp) do
      result [i] := StEmptyBmp [i];
end;



{ TDrawingGroup }

procedure TDrawingGroup.AddDwg;
begin
  if FRecordCache.Dgg<>nil then inc(FRecordCache.Dgg.FDgg.DwgSaved);
  //PENDING: fix sheets

end;

procedure TDrawingGroup.Clear;
begin
  FreeAndNil(FDggContainer);
end;

constructor TDrawingGroup.Create;
begin
  inherited Create;
end;

destructor TDrawingGroup.Destroy;
begin
  Clear;
  inherited;
end;

procedure TDrawingGroup.EnsureDwgGroup;
const
  DwgCache: TEscherDwgCache= (Destroying: false; MaxObjId:0; Dg: nil; Solver: nil; Patriarch:nil; Anchor: nil; Shape: nil; Obj: nil; Blip: nil);
var
  EscherHeader: TEscherRecordHeader;
  FDgg: TEscherDggRecord;
  BStoreContainer: TEscherBStoreRecord;
  OPTRec:TEscherOPTRecord;
  SplitMenu: TEscherSplitMenuRecord;
begin
  if FDggContainer=nil then  // there is already a DwgGroup
  begin
    //DggContainer
    EscherHeader.Pre:=$F;
    EscherHeader.Id:=MsofbtDggContainer;
    EscherHeader.Size:=0;
    FDggContainer:=TEscherContainerRecord.Create(EscherHeader, RecordCache, @DwgCache ,nil);
    FDggContainer.LoadedDataSize:=EscherHeader.Size;
  end;

  if FDggContainer.FindRec(TEscherDggRecord)=nil then
  begin
    //Dgg
    FDgg:=TEscherDggRecord.CreateFromData(RecordCache, @DwgCache ,FDggContainer);
    FDggContainer.ContainedRecords.Add(FDgg);
  end;

  if FDggContainer.FindRec(TEscherBStoreRecord)=nil then
  begin
    // BStoreContainer
    EscherHeader.Pre:=$2F;
    EscherHeader.Id:=MsofbtBstoreContainer;
    EscherHeader.Size:=0;
    BStoreContainer:=TEscherBStoreRecord.Create(EscherHeader, RecordCache, @DwgCache ,FDggContainer);
    BStoreContainer.LoadedDataSize:=EscherHeader.Size;
    FDggContainer.ContainedRecords.Add(BStoreContainer);
  end;

  if FDggContainer.FindRec(TEscherOPTRecord)=nil then
  begin
    //OPT
    OPTRec:=TEscherOPTRecord.GroupCreateFromData(RecordCache, @DwgCache, FDggContainer);
    FDggContainer.ContainedRecords.Add(OPTRec);
  end;

  if FDggContainer.FindRec(TEscherSplitMenuRecord)=nil then
  begin
    //SplitMenuColors
    SplitMenu:=TEscherSplitMenuRecord.CreateFromData(RecordCache, @DwgCache, FDggContainer);
    FDggContainer.ContainedRecords.Add(SplitMenu);
  end;

end;

function TDrawingGroup.GetRecordCache: PEscherDwgGroupCache;
begin
  Result:=@FRecordCache;
end;

procedure TDrawingGroup.LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const First: TDrawingGroupRecord);
const
  DwgCache: TEscherDwgCache= (Destroying: false; MaxObjId:0; Dg: nil; Solver: nil; Patriarch:nil; Anchor: nil; Shape: nil; Obj: nil; Blip: nil);
var
  aPos: integer;
  EscherHeader: TEscherRecordHeader;
  MyRecord, CurrentRecord: TBaseRecord;
begin
  if FDggContainer<>nil then raise Exception.Create(ErrExcelInvalid);
  aPos:=0;
  MyRecord:= First; CurrentRecord:= First;
  try
    ReadMem(MyRecord, aPos, SizeOf(EscherHeader), @EscherHeader);
    FDggContainer:= TEscherContainerRecord.Create(EscherHeader, RecordCache, @DwgCache ,nil);
    while not FDggContainer.Loaded do
    begin
      if (MyRecord.Continue=nil) and (aPos=MyRecord.DataSize) then
      begin
        if CurrentRecord<> First then FreeAndNil(CurrentRecord);
        CurrentRecord:=LoadRecords(DataStream, RecordHeader);
        MyRecord:= CurrentRecord;
        aPos:=0;
        if not(MyRecord is TDrawingGroupRecord) then raise Exception.Create(ErrExcelInvalid);
      end;

      FDggContainer.Load(MyRecord, aPos);

    end; //while
  finally
    if CurrentRecord<>First then FreeAndNil(CurrentRecord);
  end; //finally

  First.Free;   //last statment
end;

procedure TDrawingGroup.SaveToStream(const DataStream: TOle2File);
var
  BreakList: TBreakList;
  NextPos, RealSize, NewDwg: integer;
begin
  if FDggContainer=nil then exit;
  BreakList:= TBreakList.Create(DataStream.Position);
  try
    NextPos:=0;
    RealSize:=0;
    NewDwg:= xlr_MSODRAWINGGROUP;
    FDggContainer.SplitRecords(NextPos, RealSize, NewDwg, BreakList);
    BreakList.Add(0, NextPos);
    FDggContainer.SaveToStream(DataStream, BreakList);
  finally
    FreeAndNil(BreakList);
  end; //finally
end;

function TDrawingGroup.TotalSize: int64;
var
  NextPos, RealSize, NewDwg: integer;
begin
  if FDggContainer=nil then begin Result:=0; exit;end;

  NextPos:=0; RealSize:=0; NewDwg:= xlr_MSODRAWINGGROUP;
  FDggContainer.SplitRecords(NextPos, RealSize, NewDwg, nil);
  Result:=RealSize;
end;

{ TDrawing }

procedure TDrawing.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  if (FRecordCache.Obj<> nil) then
    FRecordCache.Obj.ArrangeCopySheet(SheetInfo);
end;

procedure TDrawing.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo; const dSheet: TObject);
begin
  if (FRecordCache.Anchor<> nil) and (SheetInfo.FormulaSheet= SheetInfo.InsSheet)then
    FRecordCache.Anchor.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount, SheetInfo, false, dSheet);
  if (FRecordCache.Obj<> nil) then
    FRecordCache.Obj.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount, SheetInfo, false, dSheet);
end;

procedure TDrawing.AssignDrawing(const Index: integer; const Data: ByteArray;
  const DataType: TXlsImgTypes);
begin
  if Length(Data)= 0 then ClearImage(Index)  //XP crashes with a 0 byte image.
  else FRecordCache.Blip[Index].ReplaceImg(Data, DataType);
end;

procedure TDrawing.DeleteImage(const Index: integer);
begin
  if FRecordcache.Blip=nil then exit;
  if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);
  FRecordCache.Patriarch.ContainedRecords.Remove(FRecordCache.Blip[Index].FindRoot);
end;

procedure TDrawing.ClearImage(const Index: integer);
begin
  FRecordCache.Blip[Index].ReplaceImg(ByteArray(EmptyBmp), xli_Bmp);
end;

procedure TDrawing.Clear;
begin
  FreeAndNil(FDgContainer);
  //Order is important... Cache should be freed after DgContainer
  FreeAndNil(FRecordCache.Anchor);
  FreeAndNil(FRecordCache.Obj);
  FreeAndNil(FRecordCache.Shape);
  FreeAndNil(FRecordCache.Blip);
end;

procedure TDrawing.CopyFrom(const aDrawing: TDrawing; const dSheet: TObject);
begin
  Clear;
  FRecordCache.MaxObjId:=0;
  FRecordCache.Dg:=nil; FRecordCache.Patriarch:=nil;

  if aDrawing.FRecordCache.Anchor<>nil then
  begin
    FRecordCache.Anchor:= TEscherAnchorCache.Create;
    FRecordCache.Obj:= TEscherObjCache.Create;
    FRecordCache.Shape:= TEscherShapeCache.Create;
    FRecordCache.Blip:=TEscherOPTCache.Create;
  end;

  if aDrawing.FDgContainer=nil then FreeAndNil(FDgcontainer) else
  begin
    aDrawing.FDgContainer.ClearCopiedTo;