tmsuescherrecords.pas

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

  id: Int64;
begin
  Found := -1;
  if GetNewId then
  begin
    DgId := 1;
    begin
      i := 16;
      while (i + 7) < TotalDataSize do
      try
        begin
          id := GetLongWord(Data, i);
          if (Found < 0) and (id = 0) then
          begin
            Found := i;
          end;

          if id >= DgId then
            DgId := integer(id + 1);

        end;
      finally
        i:= i + 8;
      end;

    end;
  end
  else
  begin
    begin
      i := TotalDataSize - 8;
      while i >= 16 do
      try
        begin
          id := GetLongWord(Data, i);
          if (Found < 0) and (id = 0) then
          begin
            Found := i;
          end;

          if id = DgId then
            break;

        end;
      finally
        i:= i - 8;
      end;

    end;
  end;

  if Found < 0 then
  begin
    ReallocMem(Data, TotalDataSize + 8);
    FDgg := PDgg(Data);
    Found := TotalDataSize;
    inc (TotalDataSize, 8);
    LoadedDataSize:= LoadedDataSize + 8;
    inc(FDgg.FIDclCount);
  end;

  Assert(Found > 0);
  Assert(Found + 8 <= TotalDataSize);
  SetLongWord(Data, Found, DgId);
  SetLongWord(Data, Found + 4, ShapeCount);
  FirstShapeId := (((Found - 16) div 8) + 1) * 1024;
end;

procedure TEscherDggRecord.GetNewDgIdAndCluster(out DgId: integer; out FirstShapeId: Int64);
begin
  DgId := -1;
  GetNewCluster(DgId, true, 0, FirstShapeId);
  Inc(FDgg.DwgSaved);
end;

procedure TEscherDggRecord.AddNewCluster(DgId: integer; const ShapeCount: Int64; out FirstShapeId: Int64);
begin
  GetNewCluster(DgId, false, ShapeCount, FirstShapeId);
end;

procedure TEscherDggRecord.DestroyClusters(const DgId: integer);
var
  i: integer;
begin
  begin
    i := 16;
    while (i + 7) < TotalDataSize do
    try
      begin
        if Int64(GetLongWord(Data, i)) = DgId then
        begin
          SetLongWord(Data, i, 0);
        end;

      end;
    finally
      i:= i + 8;
    end;

  end;
  Dec(FDgg.DwgSaved);
end;

function TEscherDggRecord.AddImage(const DgId: integer; const LastImageId: Int64): Int64;
var
  ExpectedCluster: integer;
  ExpectedClusterPos: integer;
  ExpectedDgId: Int64;
  IdInCluster: Int64;
  MaxShapeId: Int64;
begin
  Result := -1;
  ExpectedCluster := LastImageId div 1024 - 1;
  ExpectedClusterPos := 16 + (ExpectedCluster * 8);
  if (ExpectedClusterPos >= 16) and (ExpectedClusterPos <= TotalDataSize - 8) then
  begin
    ExpectedDgId := GetLongWord(Data, ExpectedClusterPos);
    if ExpectedDgId = DgId then
    begin
      IdInCluster := GetLongWord(Data, ExpectedClusterPos + 4);
      if IdInCluster < 1024 then
      begin
        Result := ((ExpectedCluster + 1) * 1024) + Int64(GetLongWord(Data, ExpectedClusterPos + 4));
        IncLongWord(Data, ExpectedClusterPos + 4, 1);
      end;
    end;

  end;

  if Result < 0 then
  begin
    AddNewCluster(DgId, 1, Result);
  end;

  inc(FDgg.ShapesSaved);
  MaxShapeId := FDgg.MaxShapeId;
  if (Result + 1) > MaxShapeId then
    FDgg.MaxShapeId := Result + 1;

end;

procedure TEscherDggRecord.RemoveImage(const DgId: integer);
begin
  Dec(FDgg.ShapesSaved);
end;

function TEscherDggRecord.IsEmpty(): Boolean;
begin
  Result := FDgg.DwgSaved <= 0;
end;



{ TEscherSpgrContainerRecord }

constructor TEscherSpgrContainerRecord.Create(
  const aEscherHeader: TEscherRecordHeader;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  if (DwgCache.Patriarch=nil) then DwgCache.Patriarch:=Self;
end;

destructor TEscherSpgrContainerRecord.Destroy;
begin
  if DwgCache.Patriarch=Self then DwgCache.Patriarch:=nil;
  inherited;
end;

{ TEscherSolverContainerRecord }

procedure TEscherSolverContainerRecord.ArrangeCopyRowsAndCols(const dSheet: TObject);
var
  i: integer;
begin
  for i:=0 to FContainedRecords.Count-1 do
    (FContainedRecords[i] as TRuleRecord).ArrangeCopyRowsAndCols(dSheet);
end;

procedure TEscherSolverContainerRecord.CheckMax(const aRuleId: LongWord);
begin
  if MaxRuleId<aRuleId then MaxRuleId:=aRuleId;
end;

constructor TEscherSolverContainerRecord.Create(
  const aEscherHeader: TEscherRecordHeader;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  if (DwgCache.Solver=nil) then DwgCache.Solver:=Self else raise Exception.Create(ErrSolverDuplicated);
end;

procedure TEscherSolverContainerRecord.DeleteRef(
  const Shape: TEscherSPRecord);
var
  i: integer;
begin
  for i:=FContainedRecords.Count-1 downto 0 do
    if (FContainedRecords[i] as TRuleRecord).DeleteRef(Shape) then FContainedRecords.Delete(i);
end;

destructor TEscherSolverContainerRecord.Destroy;
begin
  DwgCache.Solver:=nil;
  inherited;
end;

procedure TEscherSolverContainerRecord.FixPointers;
var
  i: integer;
begin
  for i:=0 to FContainedRecords.Count-1 do
    (FContainedRecords[i] as TRuleRecord).FixPointers;
end;

function TEscherSolverContainerRecord.IncMaxRuleId: LongWord;
begin
  inc(MaxRuleId,2);
  Result:=MaxRuleId;
end;

{ TEscherSpContainerRecord }

function TEscherSpContainerRecord.Col: integer;
begin
  if ClientAnchor<>nil then Result:=ClientAnchor.Col else Result:=0;
end;

function TEscherSpContainerRecord.Row: integer;
begin
  if ClientAnchor<>nil then Result:=ClientAnchor.Row else Result:=0;
end;


{ TEscherOPTRecord }

function TEscherOPTRecord.Col: integer;
var
  Fr: TEscherRecord;
begin
  Fr:=FindRoot;
  if (DwgCache.Patriarch=nil) or (Fr=nil) or not( Fr is TEscherSpContainerRecord) or ((Fr as TEscherSpContainerRecord).ClientAnchor=nil) then Result:=0
  else Result:=(Fr as TEscherSpContainerRecord).ClientAnchor.Col;
end;

constructor TEscherOPTRecord.Create(
  const aEscherHeader: TEscherRecordHeader;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  if (FParent <> nil) and (FParent is TEscherSpContainerRecord) then (FParent as TEscherSpContainerRecord).OPT:=self;
end;

destructor TEscherOPTRecord.Destroy;
var
  i: integer;
begin
  if (Length(BlipPtr)>0) and not DwgCache.Destroying then
  begin
    for i:=0 to Length(BlipPtr)-1 do
      BlipPtr[i].Release;
    if DwgCache.Blip<>nil then DwgCache.Blip.Remove(Self);
  end;

  if (FParent <> nil) and (FParent is TEscherSpContainerRecord) then (FParent as TEscherSpContainerRecord).Opt:=nil;

  inherited;
end;

function TEscherOPTRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
var
  i: integer;
begin
  Result:= inherited DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);

  if (DwgCache.Blip<>nil) and (Length(BlipPos)>0) then NewDwgCache.Blip.Add(Result as TEscherOptRecord);
  (Result as TEscherOPTRecord).BlipPtr:= copy(BlipPtr, Low(BlipPtr), 1+High(BlipPtr)-Low(BlipPtr));
  (Result as TEscherOPTRecord).BlipPos:= copy(BlipPos, Low(BlipPos), 1+High(BlipPos)-Low(BlipPos));
  (Result as TEscherOPTRecord).FShapeName:=FShapeName;

  if Length(BlipPtr)>0 then for i:=0 to Length(BlipPtr)-1 do
    BlipPtr[i].AddRef;
end;

function TEscherOPTRecord.GetShapeName: UTF16String;
begin
  Result:=FShapeName;
end;

function TEscherOPTRecord.Row: integer;
var
  Fr: TEscherRecord;
begin
  Fr:=FindRoot;
  if (DwgCache.Patriarch=nil) or (Fr=nil) or not( Fr is TEscherSpContainerRecord) or ((Fr as TEscherSpContainerRecord).ClientAnchor=nil) then Result:=0
  else Result:=(Fr as TEscherSpContainerRecord).ClientAnchor.Row;
end;

procedure TEscherOPTRecord.SaveToStream(const DataStream: TOle2File;
  const BreakList: TBreakList);
var
  i: integer;
begin
  //Fix Blip ids
  Assert(Length(BlipPtr)=Length(BlipPos), ErrInternal);
  for i:=0 to Length(BlipPos)-1 do
    PLongWord(PAddress(Data)+ BlipPos[i])^:= BlipPtr[i].BStorePos;

  inherited;
end;

procedure TEscherOPTRecord.AfterCreate;
var
  i, tPos: integer;
  Pid: word;
  ComplexOfs: LongWord;
  NameLen: PLongWord;
  NameOfs: LongWord;

begin
  if DwgCache.Blip=nil then exit;
  tPos:=0; ComplexOfs:=0;
  for i:=0 to Instance-1 do
  begin
    if tPos+6> TotalDataSize then Raise Exception.Create(ErrLoadingEscher);
    Pid:= GetWord(Data, tPos);
    if ((Pid and (1 shl 15)) = 0)and ((Pid and (1 shl 14))=(1 shl 14)) then //blip
    begin
      SetLength(BlipPtr, Length(BlipPtr)+1);
      BlipPtr[Length(BlipPtr)-1]:= DwgGroupCache.Bstore.ContainedRecords[PLongWord(PAddress(Data)+ tPos+2)^-1] as TEscherBSERecord;
      SetLength(BlipPos, Length(BlipPos)+1);
      BlipPos[Length(BlipPos)-1]:= tPos+2;
      if (DwgCache.Blip<>nil) and (Length(BlipPos)=1) then DwgCache.Blip.Add(Self);
    end;
    if (Pid and ($FFFF shr 2))=896 then    //Shape Name
    begin
      NameLen:= PLongWord(PAddress(Data)+ tPos+2);
      NameOfs:= ComplexOfs;
      SetLength(FShapeName, NameLen^ div 2-1);
      Move((PAddress(Data)+NameOfs+Instance*6)^, FShapeName[1], NameLen^-2);

    end;

    if Pid and (1 shl 15) = 1 shl 15 then //Complex property
      inc(ComplexOfs, PLongWord(PAddress(Data)+ tPos+2)^);

    //Goto Next
    inc(tPos, 6)
  end;
end;

procedure TEscherOPTRecord.ChangeRef(const aBSE: TEscherBSERecord);
begin
  if Length(BlipPtr)<>1 then raise Exception.Create(ErrChangingEscher);
  if BlipPtr[0]=aBSE then exit;
  aBSE.AddRef;
  BlipPtr[0].Release;
  BlipPtr[0]:=aBSE;
end;

function TEscherOPTRecord.AddImg(const Data: ByteArray; const DataType: TXlsImgTypes): integer;
var
  BSE: TEscherBSERecord;
  BStore: TEscherBStoreRecord;
begin
  BStore:=DwgGroupCache.BStore;
  Assert(BStore<>nil, 'BStore can''t be nil');
  BSE:= ConvertGraphicToBSE(Data, DataType, DwgGroupCache, DwgCache);
  if not BStore.ContainedRecords.Find( BSE, Result)
   then BStore.ContainedRecords.Insert(Result, BSE) else FreeAndNil(BSE);
  (BStore.ContainedRecords[Result] as TEscherBSERecord).AddRef;
end;

procedure TEscherOPTRecord.ReplaceImg(const Data: ByteArray; const DataType: TXlsImgTypes);
var
  BSE: TEscherBSERecord;
  BStore: TEscherBStoreRecord;
  Index: integer;
begin
  BStore:=DwgGroupCache.BStore;
  Assert(BSt