tmsuescherrecords.pas

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

    if (Deltax>1024) then Deltax:=1024;
  end
end;

procedure CalcRowAndDy(const Workbook: TWorkSheet; const RectY: integer; out RowFinal, Deltay: integer);
var
  Row, y, Lasty: integer;
  fw: double;
begin
  Row:=0;
  y:=0;
  Lasty :=0;

  while (Row<=Max_Rows) and (y<= RectY) do
  begin
    Lasty := y;
    inc(y, Workbook.GetRowHeight(Row, true));
    inc(Row);
  end;

  RowFinal:=Row-1;

  if (RowFinal<0) then
  begin
    RowFinal:=0;
    Deltay:=0;
  end
  else
  begin
    fw := Workbook.GetRowHeight(RowFinal, true);
    if (Workbook.GetRowHeight(RowFinal, true)>0) then
      Deltay := Round((RectY-Lasty) / fw * 255.0)
    else Deltay:=0;

    if (Deltay>255) then Deltay:=255;
  end;
end;


procedure TEscherClientAnchorRecord.RestoreObjectCoords(const dSheet: TObject);
var
  aSheet: TWorksheet;
  x1, y1: integer;
  Col, Row, Dx, Dy: integer;
begin
  if (dSheet = nil) then exit;
  aSheet := dSheet as TWorksheet;

  case (Anchor.Flag and 3) of
    1, 2:  //Move and dont resize
    begin
        CalcAbsCol(aSheet, Anchor.Col1, Anchor.Dx1, x1);
        CalcAbsRow(aSheet, Anchor.Row1, Anchor.Dy1, y1);

        CalcColAndDx(aSheet, x1 + SaveRect.x2 - SaveRect.x1, Col, Dx); Anchor.Col2 := Col; Anchor.Dx2 := Dx;
        CalcRowAndDy(aSheet, y1 + SaveRect.y2 - SaveRect.y1, Row, Dy); Anchor.Row2 := Row; Anchor.Dy2 := Dy;
    end;

    3: //Dont move and dont resize
    begin
      CalcColAndDx(aSheet, SaveRect.x1, Col, Dx); Anchor.Col1 := Col; Anchor.Dx1 := Dx;
      CalcColAndDx(aSheet, SaveRect.x2, Col, Dx); Anchor.Col2 := Col; Anchor.Dx2 := Dx;
      CalcRowAndDy(aSheet, SaveRect.y1, Row, Dy); Anchor.Row1 := Row; Anchor.Dy1 := Dy;
      CalcRowAndDy(aSheet, SaveRect.y2, Row, Dy); Anchor.Row2 := Row; Anchor.Dy2 := Dy;
    end;
  end; //case
end;

procedure TEscherClientAnchorRecord.SaveObjectCoords(const sSheet: TObject);
var
  aSheet: TWorksheet;
  x1, x2, y1, y2: integer;
begin
  if (sSheet = nil) then exit;
  aSheet := sSheet as TWorksheet;

  if (Anchor.Flag and 3) = 0 then Exit;

  //move but not resize
  //do not move and do not resize

  CalcAbsCol(aSheet, Anchor.Col1, Anchor.Dx1, x1);
  CalcAbsRow(aSheet, Anchor.Row1, Anchor.Dy1, y1);
  CalcAbsCol(aSheet, Anchor.Col2, Anchor.Dx2, x2);
  CalcAbsRow(aSheet, Anchor.Row2, Anchor.Dy2, y2);

  SaveRect.x1  := x1;
  SaveRect.x2  := x2;
  SaveRect.y1  := y1;
  SaveRect.y2  := y2;
end;


{ TEscherBSERecord }

procedure TEscherBSERecord.AddRef;
begin
  IncLongWord(Data,24,1);
end;

function TEscherBSERecord.CompareRec( const aRecord: TEscherRecord): integer;
type
  TUid=array[0..15] of byte;
  PUid=^TUid;
var
  Uid1, Uid2: PUid;
  i:integer;
begin
  //We can't just compare the data of the 2 records, because cRef can be different
  //no inherited

  if TotalDataSize< aRecord.TotalDataSize then Result:=-1 else if TotalDataSize> aRecord.TotalDataSize then Result:=1 else
  begin
    Uid1:= PUid(PAddress(Data)+2);
    Uid2:= PUid(PAddress((aRecord as TEscherBSERecord).Data)+2);
    for i:=0 to SizeOf(TUid)-1 do
      if Uid1[i]<Uid2[i] then
      begin
        Result:=-1;
        exit;
      end else
      if Uid1[i]>Uid2[i] then
      begin
        Result:=1;
        exit;
      end;

    Result:= 0;
  end;
end;

procedure TEscherBSERecord.CopyFromData(
  const BSEHeader: Pointer; const BlipHeader: TEscherRecordHeader; const BlipData: TMemoryStream);
var
  blp: PArrayOfByte;
begin
  if 36+BlipData.Size+SizeOf(BlipHeader)<> TotalDataSize then raise exception.Create(ErrInternal);
  System.Move(BSEHeader^, Data^, 36);
  System.Move(BlipHeader, (PAddress(Data)+36)^, SizeOf(BlipHeader));
  blp:=PArrayOfByte(PAddress(Data)+36+SizeOf(BlipHeader));
  BlipData.ReadBuffer(blp^, BlipData.Size);
  LoadedDataSize:=TotalDataSize;
end;

function TEscherBSERecord.References: LongWord;
begin
  References:= GetLongWord(Data, 24);
end;

procedure TEscherBSERecord.Release;
begin
  if self=nil then exit;
  IncLongWord(Data,24,-1);
  if (References=0)and (DwgGroupCache.BStore<>nil) then
    DwgGroupCache.BStore.ContainedRecords.Remove(Self); //When refs=0 , delete from bstore
end;

//This is the header to write a bitmap to disk
type
  tagBITMAPFILEHEADER = packed record
    bfType: Word;
    bfSize: LongWord;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: LongWord;
  end;

procedure TEscherBSERecord.SaveGraphicToStream(const aData: TStream; out aDataType: TXlsImgTypes);
var
  HeadOfs: integer;
  BmpHead: tagBITMAPFILEHEADER;
begin
  case Data[0] of
    msoblipEMF  : aDataType:=xli_Emf;
    msoblipWMF  : aDataType:=xli_Wmf;
    msoblipJPEG : aDataType:=xli_Jpeg;
    msoblipPNG  : aDataType:=xli_Png;
    msoblipDIB  : aDataType:=xli_Bmp;
    else aDataType:=xli_Unknown;
  end; //case
  if aDataType in [xli_JPEG, xli_PNG, xli_BMP] then HeadOfs:=17 else HeadOfs:=16;

  if aDataType = xli_Bmp then
  begin
    FillChar(BmpHead, SizeOf(BmpHead), 0);
    BmpHead.BfType:=$4D42;
    aData.WriteBuffer(BmpHead, SizeOf(BmpHead));
  end;

  aData.WriteBuffer((PAddress(Data)+36+SizeOf(TEscherRecordHeader)+HeadOfs)^ , TotalDataSize-36-SizeOf(TEscherRecordHeader)-HeadOfs);
end;

{ TEscherBStoreRecord }

procedure TEscherBStoreRecord.AddRef(const BlipPos: integer);
begin
  if (BlipPos<1)or(BlipPos> FContainedRecords.Count) then raise Exception.Create(ErrExcelInvalid);
  (FContainedRecords[BlipPos-1] as TEscherBSERecord).AddRef;
end;

constructor TEscherBStoreRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  if (DwgGroupCache.BStore=nil) then DwgGroupCache.BStore:=Self else raise Exception.Create(ErrBStroreDuplicated);
end;

destructor TEscherBStoreRecord.Destroy;
begin
  DwgGroupCache.BStore:=nil;
  inherited;
end;

procedure TEscherBStoreRecord.Release(const BlipPos: integer);
begin
  if (BlipPos<1)or(BlipPos> FContainedRecords.Count) then raise Exception.Create(ErrExcelInvalid);
  (FContainedRecords[BlipPos-1] as TEscherBSERecord).Release;
end;

procedure TEscherBStoreRecord.SaveToStream(const DataStream: TOle2File;
  const BreakList: TBreakList);
var
  i: integer;
begin
  //Fix bse positions
  for i:=0 to FContainedRecords.Count-1 do (FContainedRecords[i] as TEscherBSERecord).BStorePos:=i+1;
  inherited;
end;

{ TEscherDgRecord }

constructor TEscherDgRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  Dg:= Pdg(Data);
  if (DwgCache.Dg=nil) then DwgCache.Dg:=Self else raise Exception.Create(ErrDgDuplicated);
end;

constructor TEscherDgRecord.CreateFromData(const csp, cspidCur: LongWord; const FirstShapeId: int64;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
var
  EscherHeader: TEscherRecordHeader;
begin
  EscherHeader.Pre:= cspidCur shl 4;
  EscherHeader.Id:=MsofbtDg;
  EscherHeader.Size:=2*SizeOf(LongWord);
  Create(EscherHeader, aDwgGroupCache, aDwgCache, aParent);
  SetLongWord(Data, 0, csp);
  SetLongWord(Data, 4, FirstShapeId + 1);
  LoadedDataSize:=TotalDataSize;
end;

procedure TEscherDgRecord.DecShapeCount;
begin
  dec(Dg.ShapeCount);
  DwgGroupCache.Dgg.RemoveImage(Instance);
end;

destructor TEscherDgRecord.Destroy;
begin
  DwgGroupCache.Dgg.DestroyClusters(Instance);
  DwgCache.Dg:=nil;
  inherited;
end;

function TEscherDgRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache;
  const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
var
  DgId : integer;
  FirstShapeId: Int64;
begin
  Result := inherited DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);
  Dg.ShapeCount := 0;
  (Result as TEscherDgRecord).DwgGroupCache.Dgg.GetNewDgIdAndCluster(DgId, FirstShapeId);
  (Result as TEscherDgRecord).Pre := DgId shl 4;
  (Result as TEscherDgRecord).Dg.MaxSpId := FirstShapeId + 1;
end;

function TEscherDgRecord.IncMaxShapeId: LongWord;
var
  LastImageId: int64;
begin
  inc(Dg.ShapeCount);
  LastImageId := Dg.MaxSpId;

  Result := DwgGroupCache.Dgg.AddImage(Instance, LastImageId);
  Dg.MaxSpId := Result;
end;

{ TEscherSPRecord }

constructor TEscherSPRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  ShapeId:=PLongWord(Data);
  if DwgCache.Shape<>nil then DwgCache.Shape.Add(Self);
  if FParent <> nil then (FParent as TEscherSpContainerRecord).SP:=self;
end;

constructor TEscherSPRecord.CreateFromData(const Pre, aShapeId, Flags: LongWord;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
var
  RecordHeader: TEscherRecordHeader;
begin
  RecordHeader.Id:=MsofbtSp;
  RecordHeader.Pre:=Pre;
  RecordHeader.Size:=8;

  Create(RecordHeader, aDwgGroupCache, aDwgCache, aParent);
  ShapeId^:=aShapeId;
  SetLongWord(Data, 4, Flags);
  LoadedDataSize:=RecordHeader.Size;

end;

destructor TEscherSPRecord.Destroy;
var
  Index: integer;
begin
  if not DwgCache.Destroying then
  begin
    if DwgCache.Dg<>nil then  DwgCache.Dg.DecShapeCount;
    if DwgCache.Solver<>nil then DwgCache.Solver.DeleteRef(Self);
    if DwgCache.Shape<>nil then
      if DwgCache.Shape.Find(ShapeId^,Index) then
        DwgCache.Shape.Delete(Index);
    if FParent <> nil then (FParent as TEscherSpContainerRecord).SP:=nil;
  end;

  //MADE: Delete all references in connectors with shapedest= self;
  inherited;
end;

function TEscherSPRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
begin
  Result:=inherited DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);
  //if NewDwgCache=DwgCache then
  (Result as TEscherSPRecord).ShapeId^:= Result.DwgCache.Dg.IncMaxShapeId;
end;

{ TEscherDggRecord }

constructor TEscherDggRecord.Create(
  const aEscherHeader: TEscherRecordHeader;
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  FDgg:= PDgg(Data);
  if (DwgGroupCache.Dgg=nil) then DwgGroupCache.Dgg:=Self else raise Exception.Create(ErrDggDuplicated);
end;

constructor TEscherDggRecord.CreateFromData(
  const aDwgGroupCache: PEscherDwgGroupCache;
  const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
var
  RecordHeader: TEscherRecordHeader;
begin
  RecordHeader.Id:=MsofbtDgg;
  RecordHeader.Pre:=0;
  RecordHeader.Size:=16;

  Create(RecordHeader, aDwgGroupCache, aDwgCache, aParent);
  FillChar(Data^, RecordHeader.Size, 0);
  FDgg.MaxShapeId:=2;
  FDgg.FIDclCount:=1;
  FDgg.ShapesSaved:=0;
  FDgg.DwgSaved:=0;

  LoadedDataSize:=RecordHeader.Size;

end;

destructor TEscherDggRecord.Destroy;
begin
  DwgGroupCache.Dgg:=nil;
  inherited;
end;


procedure TEscherDggRecord.GetNewCluster(var DgId: integer; const GetNewId: Boolean; const ShapeCount: Int64; out FirstShapeId: int64);
var
  Found: integer;
  i: integer;