tmsuxlsescher.pas

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

  RecordHeader: TEscherRecordHeader;
  SPRec: TEscherSpContainerRecord;
  SP: TEscherSpRecord;
  OPTRec: TEscherOPTRecord;
  ClientAnchor: TClientAnchor;
  AnchorRec: TEscherClientAnchorRecord;
  Obj: TEscherClientDataRecord;
  aMsObj: TMsObj;
begin
  FDrawingGroup.EnsureDwgGroup;
  if (FDgContainer = nil) or (FRecordCache.Anchor = nil) then  //no drawings on this sheet
    CreateBasicDrawingInfo;

  RecordHeader.Id := Int32(MsofbtSpContainer);
  RecordHeader.Pre := 15;
  RecordHeader.Size := 0;  //Size for a container is calculated later

  SPRec:=TEscherSpContainerRecord.Create(RecordHeader, FDrawingGroup.RecordCache, @FRecordCache, FRecordCache.Patriarch);
  try
    SPRec.LoadedDataSize:=RecordHeader.Size;

    SP:=TEscherSPRecord.CreateFromData($0C92, FRecordCache.Dg.IncMaxShapeId, $A00 , FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      SPRec.ContainedRecords.Add(SP);
    except
      FreeAndNil(SP);
      raise;
    end; //except

    OPTRec:=TEscherOPTRecord.CreateFromDataAutoFilter(FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      SPRec.ContainedRecords.Add(OPTRec);
    except
      FreeAndNil(OPTRec);
      raise;
    end; //except

    RecordHeader.Id:=MsofbtClientAnchor;
    RecordHeader.Pre:=0;
    RecordHeader.Size:=SizeOf(TClientAnchor);
    ClientAnchor.Flag:=01; //AutoFilters have a "1" as flag. This is not documented.

    ClientAnchor.Col1:=Col;
    ClientAnchor.Dx1:=0;
    ClientAnchor.Col2:=Col + 1;
    ClientAnchor.Dx2:=0;
    ClientAnchor.Row1:=Row;
    ClientAnchor.Dy1:=0;
    ClientAnchor.Row2:=Row + 1;
    ClientAnchor.Dy2:=0;
    AnchorRec:=TEscherClientAnchorRecord.CreateFromData(ClientAnchor, RecordHeader, FDrawingGroup.RecordCache, @FRecordCache, SPRec, sSheet);
    try
      SPRec.ContainedRecords.Add(AnchorRec);
    except
      FreeAndNil(AnchorRec);
      raise;
    end;

    Obj:=TEscherClientDataRecord.CreateFromData(FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      aMsObj:=TMsObj.CreateEmptyAutoFilter(FRecordCache.MaxObjId);
      try
        Obj.AssignClientData(aMsObj);
      except
        FreeAndNil(aMsObj);
        raise;
      end; //Except

      SPRec.ContainedRecords.Add(Obj);
    except
      FreeAndNil(Obj);
      raise;
    end;

    FRecordCache.Patriarch.ContainedRecords.Add(SPRec);
  except
    FreeAndNil(SPRec);
    raise;
  end; //except
end;


procedure TDrawing.LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader;
  const First: TDrawingRecord; const SST: TSST);
var
  aPos, CdPos: integer;
  EscherHeader: TEscherRecordHeader;
  MyRecord, CurrentRecord, R, CdRecord: TBaseRecord;
  FClientData: TBaseClientData;
  ClientType: ClassOfTBaseClientData;
begin
  Assert (FDrawingGroup<>nil,'DrawingGroup can''t be nil');
  if FDgContainer<>nil then raise Exception.Create(ErrExcelInvalid);

  FRecordCache.MaxObjId:=0;
  FRecordCache.Dg:=nil; FRecordCache.Patriarch:=nil; FRecordCache.Solver:=nil;
  FRecordCache.Anchor:= TEscherAnchorCache.Create;
  FRecordCache.Obj:= TEscherObjCache.Create;
  FRecordCache.Shape:= TEscherShapeCache.Create;
  FRecordCache.Blip:= TEscherOPTCache.Create;

  aPos:=0;
  MyRecord:= First; CurrentRecord:= First;
  try
    ReadMem(MyRecord, aPos, SizeOf(EscherHeader), @EscherHeader);
    FDgContainer:= TEscherContainerRecord.Create(EscherHeader, FDrawingGroup.RecordCache, @FRecordCache ,nil);
    while (not FDgContainer.Loaded) or FDgContainer.WaitingClientData(ClientType) do
    begin
      if not FDgContainer.WaitingClientData(ClientType) then
      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 TDrawingRecord) then
            raise Exception.Create(ErrExcelInvalid);
        end;
        FDgContainer.Load(MyRecord, aPos);
      end else
      begin
        if not ((MyRecord.Continue=nil) and (aPos=MyRecord.DataSize)) then raise Exception.Create(ErrExcelInvalid);

         R:=LoadRecords(DataStream, RecordHeader);
         try
           if (R is ClientType.ObjRecord) then
           begin
             FClientData:= ClientType.Create;
             try
               FClientData.LoadFromStream(DataStream, RecordHeader, R , SST);
               FDgContainer.AssignClientData(FClientData);
               if FClientData.RemainingData<>nil then
               begin
                 CdRecord:=FClientData.RemainingData; //we dont have to free this
                 CdPos:=0;
                 FDgContainer.Load(CdRecord, CdPos);
               end;
             except
               FreeAndNil(FClientData);
               raise;
             end; //except
           end else raise Exception.Create(ErrInvalidDrawing);
         except
           FreeAndNil(R);
           raise;
         end; //Except
      end;

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

  FRecordCache.Shape.Sort; // only here the values are loaded...
  if FRecordCache.Solver <>nil then FRecordCache.Solver.FixPointers;


  //PENDING: Wmf, emf

  First.Free;   //last statment
end;

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

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

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

function TDrawing.AddNewComment(const Properties: TImageProperties; const sSheet: TObject): TEscherClientDataRecord;
var
  aTXO: TTXO;
  aMsObj: TMsObj;
  SP: TEscherSPRecord;
  SPRec: TEscherSpContainerRecord;
  RecordHeader: TEscherRecordHeader;
  TXORec: TEscherClientTextBoxRecord;
  Obj: TEscherClientDataRecord;
  ClientAnchor: TClientAnchor;
  AnchorRec: TEscherClientAnchorRecord;
  OPTRec:TEscherOPTRecord;
begin
  FDrawingGroup.EnsureDwgGroup;
  if (FDgContainer=nil) or (FRecordCache.Anchor= nil) then //no drawings on this sheet
    CreateBasicDrawingInfo;

  RecordHeader.Id:=MsofbtSpContainer;
  RecordHeader.Pre:=$F;
  RecordHeader.Size:=0; //Size for a container is calculated later
  SPRec:=TEscherSpContainerRecord.Create(RecordHeader, FDrawingGroup.RecordCache, @FRecordCache, FRecordCache.Patriarch);
  try
    SPRec.LoadedDataSize:=RecordHeader.Size;

    SP:=TEscherSPRecord.CreateFromData($0CA2, FRecordCache.Dg.IncMaxShapeId, $A00 , FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      SPRec.ContainedRecords.Add(SP);
    except
      FreeAndNil(SP);
      raise;
    end; //except

    OPTRec:=TEscherOPTRecord.CreateFromDataNote(FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      SPRec.ContainedRecords.Add(OPTRec);
    except
      FreeAndNil(OPTRec);
      raise;
    end; //except

    RecordHeader.Id:=MsofbtClientAnchor;
    RecordHeader.Pre:=0;
    RecordHeader.Size:=SizeOf(TClientAnchor);
    ClientAnchor.Flag:=03;

    ClientAnchor.Col1:=Properties.Col1;
    ClientAnchor.Dx1:=Properties.dx1;
    ClientAnchor.Col2:=Properties.Col2;
    ClientAnchor.Dx2:=Properties.dx2;
    ClientAnchor.Row1:=Properties.Row1;
    ClientAnchor.Dy1:=Properties.dy1;
    ClientAnchor.Row2:=Properties.Row2;
    ClientAnchor.Dy2:=Properties.dy2;
    AnchorRec:=TEscherClientAnchorRecord.CreateFromData(ClientAnchor, RecordHeader, FDrawingGroup.RecordCache, @FRecordCache, SPRec, sSheet);
    try
      SPRec.ContainedRecords.Add(AnchorRec);
    except
      FreeAndNil(AnchorRec);
      raise;
    end;

    Obj:=TEscherClientDataRecord.CreateFromData(FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      aMsObj:=TMsObj.CreateEmptyNote(FRecordCache.MaxObjId);
      try
        Obj.AssignClientData(aMsObj);
      except
        FreeAndNil(aMsObj);
        raise;
      end; //Except

      SPRec.ContainedRecords.Add(Obj);
    except
      FreeAndNil(Obj);
      raise;
    end;

    TXORec:= TEscherClientTextBoxRecord.CreateFromData(FDrawingGroup.RecordCache, @FRecordCache, SPRec);
    try
      aTXO:=TTXO.CreateFromData;
      try
        TXORec.AssignClientData(aTXO);
      except
        FreeAndNil(aTXO);
        raise;
      end;
      SPRec.ContainedRecords.Add(TXORec);
    except
      FreeAndNil(TXORec);
      raise;
    end; //except

    FRecordCache.Patriarch.ContainedRecords.Add(SPRec);
  except
    FreeAndNil(SPRec);
    raise;
  end; //except

  Result:=Obj;
end;


procedure TDrawing.RestoreObjectCoords(const dSheet: TObject);
var
  i: integer;
begin
	if (FRecordCache.Patriarch=nil) then exit;
  for i := FRecordCache.Anchor.Count - 1 downto 0 do
	begin
		FRecordCache.Anchor[i].RestoreObjectCoords(dSheet);
  end;
end;

procedure TDrawing.SaveObjectCoords(const sSheet: TObject);
var
  i: integer;
begin
	if (FRecordCache.Patriarch=nil) then exit;
  for i := FRecordCache.Anchor.Count - 1 downto 0 do
	begin
		FRecordCache.Anchor[i].SaveObjectCoords(sSheet);
  end;
end;

end.