tmsuescherrecords.pas

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

constructor TEscherRecordCache.Create;
begin
  inherited Create(False) //We don't own the objects
end;

procedure TEscherRecordCache.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer;
  const SheetInfo: TSheetInfo; const Forced: boolean; const dSheet: TObject);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount, SheetInfo, Forced, dSheet);
end;

{ TEscherObjCache }
{$INCLUDE TEscherObjCacheImp.inc}

{ TEscherAnchorCache }
{$INCLUDE TEscherAnchorCacheImp.inc}

{ TEscherShapeCache }
{$INCLUDE TEscherShapeCacheImp.inc}

{ TEscherSPContainerCache }
{$INCLUDE TEscherOPTCacheImp.inc}

{ TEscherRecord }

procedure TEscherRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo; const Forced: boolean; const dSheet: TObject);
begin
  //Nothing
end;

procedure TEscherRecord.AssignClientData(const aClientData: TBaseClientData);
begin
  raise Exception.Create(ErrLoadingEscher);
end;

procedure TEscherRecord.ClearCopiedTo;
begin
  CopiedTo:=nil;
end;

function TEscherRecord.CopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
begin
  if Self=nil then Result:= nil   //for this to work, this can't be a virtual method
  else Result:=DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);
end;

constructor TEscherRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited Create;
  LoadedDataSize:=0;
  TotalDataSize:=aEscherHeader.Size;
  Id:= aEscherHeader.Id;
  Pre:= aEscherHeader.Pre;

  DwgGroupCache:= aDwgGroupCache;
  DwgCache:= aDwgCache;
  FParent:=aParent;
end;

function TEscherRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
var
  ERec: TEscherRecordHeader;
begin
  ERec.Id:=Id;
  ERec.Pre:=Pre;
  ERec.Size:=TotalDataSize;

  Result:= ClassOfTEscherRecord(ClassType).Create(ERec, DwgGroupCache, NewDwgCache, Nil);
  CopiedTo:=Result;
  Result.LoadedDataSize:=LoadedDataSize;
  if FParent<> nil then
    if FParent.CopiedTo<>nil then Result.FParent:= FParent.CopiedTo as TEscherContainerRecord
    else Result.FParent:=FParent
  else Result.FParent:=nil;
end;

function TEscherRecord.IsContainer(const aPre: word): boolean;
begin
  IsContainer:=(aPre and $000F ) = $000F
end;

function TEscherRecord.Loaded: boolean;
begin
  if LoadedDataSize>TotalDataSize then Raise Exception.Create(ErrInternal);
  Loaded:= TotalDataSize=LoadedDataSize;
end;

procedure TEscherRecord.WriteNewRecord(const DataStream: TOle2File; const BreakList: TBreakList);
var
 Rh: TRecordHeader;
begin
  Rh.Id:= BreakList.CurrentId;
  Rh.Size:= BreakList.CurrentSize;
  DataStream.WriteMem(Rh, SizeOf(Rh));
end;

procedure TEscherRecord.IncNextPos(var NextPos: integer; const Size: integer;var RealSize:integer; const BreakList: TBreakList);
begin
  if NextPos> MaxRecordDataSize+1 then Raise Exception.Create(ErrInternal);
  inc(NextPos, Size);
  inc(RealSize, Size);
  while NextPos>MaxRecordDataSize+1 do
  begin
    dec(NextPos, MaxRecordDataSize+1);
    inc(RealSize, SizeOf(TRecordHeader));  //continue record
    if BreakList<>nil then BreakList.Add(xlr_CONTINUE, MaxRecordDataSize+1);
  end;
end;

procedure TEscherRecord.SplitRecords(var NextPos, RealSize: integer; var NextDwg: integer; const BreakList: TBreakList);
begin
  if NextDwg>0 then
  begin
    if BreakList<>nil then BreakList.Add(NextDwg, NextPos);
    Inc(RealSize, SizeOf(TRecordHeader));
    NextPos:=0;
    NextDwg:=-1;
  end;

  IncNextPos(NextPos, SizeOf(TEscherRecordHeader), RealSize, BreakList);
end;

procedure TEscherRecord.CheckSplit(const DataStream: TOle2File; const BreakList: TBreakList);
begin
  if (DataStream.Position > BreakList.AcumSize) then Raise Exception.Create(ErrInternal);
  if DataStream.Position = BreakList.AcumSize then
  begin
    WriteNewRecord(DataStream, BreakList);
    BreakList.IncCurrent;
  end;
end;

procedure TEscherRecord.SaveToStream(const DataStream: TOle2File; const BreakList: TBreakList);
var
  Remaining:integer;
  Rs: TEscherRecordHeader;
begin
  if not Loaded then raise Exception.Create(ErrEscherNotLoaded);

  Rs.Pre:= Pre;
  Rs.Id:=Id;
  Rs.Size:=TotalSizeNoSplit-SizeOf(TEscherRecordHeader);
  CheckSplit(DataStream, BreakList);
  Remaining:= (BreakList.AcumSize - DataStream.Position) ;
  if SizeOf(Rs)>Remaining then
  begin
    DataStream.WriteMem(Rs, Remaining);
    CheckSplit(DataStream, BreakList);
    DataStream.WriteMem((PAddress(@Rs)+Remaining)^, Sizeof(Rs)-Remaining);
  end
  else DataStream.WriteMem(Rs, Sizeof(Rs));
end;

function TEscherRecord.TotalSizeNoSplit: int64;
begin
  Result:=SizeOf(TEscherRecordHeader);
end;

function TEscherRecord.WaitingClientData(out ClientType: ClassOfTBaseClientData): boolean;
begin
  Result:=false;
  ClientType:=nil;
end;

function TEscherRecord.Instance: word;
begin
  Result:= Pre shr 4;
end;

function TEscherRecord.Version: word;
begin
  Result:= Pre and $F;
end;


function TEscherRecord.FindRoot: TEscherRecord;
begin
  Result:=Self;
  if DwgCache=nil then exit;
  while (Result<>nil)and (Result.FParent<>DwgCache.Patriarch) do Result:=Result.FParent;
end;

function TEscherRecord.CopyDwg(const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
begin
  if ((DwgCache.Patriarch=nil) or (FindRoot=nil)) then raise Exception.Create(ErrLoadingEscher);
  DwgCache.Patriarch.FContainedRecords.Add(FindRoot.CopyTo(DwgCache, RowOfs, ColOfs, dSheet));
  Result:=CopiedTo;
end;

function TEscherRecord.Patriarch: TEscherSpgrContainerRecord;
begin
  if (DwgCache=nil) then Result:=nil else
  Result:=DwgCache.Patriarch;
end;

function TEscherRecord.CompareRec(const aRecord: TEscherRecord): integer;
begin
  if Id< aRecord.Id then Result:=-1 else if aRecord.Id>Id then Result:=1 else
  if Pre<aRecord.Pre then result:=-1 else if Pre>aRecord.Pre then Result:=1 else
  if TotalDataSize< aRecord.TotalDataSize then Result:=-1 else if TotalDataSize> aRecord.TotalDataSize then Result:=1 else
  Result:=0;
end;

procedure TEscherRecord.AfterCreate;
begin
  //nothing
end;

function TEscherRecord.FindRec(const RecClass: ClassOfTEscherRecord): TEscherRecord;
begin
  Result:=nil;
end;

{ TEscherRecordList }

function TEscherRecordList.TotalSizeNoSplit: int64;
var
  i: integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalSizeNoSplit;
end;

{$INCLUDE TEscherRecordListImp.inc}

procedure TEscherRecordList.SaveToStream(const DataStream: TOle2File; const BreakList: TBreakList);
var
  i:integer;
begin
  for i:=0 to Count-1 do if Items[i]<>nil then Items[i].SaveToStream(DataStream, BreakList);
end;

procedure TEscherRecordList.CopyFrom(const aEscherRecordList: TEscherRecordList; const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject);
var
  i:integer;
begin
  if aEscherRecordList=nil then exit;
  for i:=0 to aEscherRecordList.Count-1 do Add(aEscherRecordList[i].CopyTo(NewDwgCache, RowOfs, ColOfs, dSheet));
end;

{ TEscherDataRecord }

procedure TEscherDataRecord.ClearData;
begin
  FillChar(Data^, TotalDataSize, 0);
end;

function TEscherDataRecord.CompareRec(const aRecord: TEscherRecord): integer;
var
  i:integer;
begin
  Result:=inherited CompareRec(aRecord);
  if Result=0 then
  begin
    for i:=0 to TotalDataSize-1 do if Data[i]<(aRecord as TEscherDataRecord).Data[i] then begin Result:=-1; exit;end else
                                   if Data[i]>(aRecord as TEscherDataRecord).Data[i] then begin Result:=1; exit; end;
  end;
end;

constructor TEscherDataRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  GetMem(Data, TotalDataSize);
end;

destructor TEscherDataRecord.Destroy;
begin
  FreeMem(Data);
  inherited;
end;

function TEscherDataRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
begin
  Result:=inherited DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);
  Move(Data^, (Result as TEscherDataRecord).Data^, TotalDataSize);
end;

procedure TEscherDataRecord.Load(var aRecord: TBaseRecord; var aPos: integer);
var
  RSize: integer;
begin
  if TotalDataSize=0 then exit;
  RSize:=aRecord.TotalSizeNoHeaders-aPos;
  if RSize<=0 then raise Exception.Create(ErrLoadingEscher);
  if TotalDataSize - LoadedDataSize < RSize  then RSize:=TotalDataSize - LoadedDataSize;
  if LoadedDataSize+RSize> TotalDataSize then raise Exception.Create(ErrLoadingEscher);
  ReadMem(aRecord, aPos, RSize, PAddress(Data)+ LoadedDataSize);
  inc(LoadedDataSize, RSize);
end;

procedure TEscherDataRecord.SaveToStream(const DataStream: TOle2File; const BreakList: TBreakList);
var
  RemainingSize: integer;
  FracSize: integer;
begin
  inherited;
  if TotalDataSize > 0 then
  begin
    RemainingSize:= TotalDataSize;
    while RemainingSize> BreakList.AcumSize - DataStream.Position do
    begin
      FracSize:= BreakList.AcumSize - DataStream.Position;
      CheckSplit(DataStream, BreakList);
      DataStream.WriteMem((PAddress(Data)+ TotalDataSize-RemainingSize)^, FracSize);

      dec(RemainingSize, FracSize);
    end; //while

    CheckSplit(DataStream, BreakList);
    DataStream.WriteMem((PAddress(Data)+ TotalDataSize-RemainingSize)^, RemainingSize);
  end;
end;

procedure TEscherDataRecord.SplitRecords(var NextPos, RealSize: integer;
  var NextDwg: integer; const BreakList: TBreakList);
begin
  inherited;
  IncNextPos(NextPos, TotalDataSize, RealSize, BreakList);
end;

function TEscherDataRecord.TotalSizeNoSplit: int64;
begin
  Result:=inherited TotalSizeNoSplit + TotalDataSize;
end;

{ TEscherContainerRecord }

procedure TEscherContainerRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer; const SheetInfo: TSheetInfo; const Forced: boolean; const dSheet: TObject);
var
  i:integer;
begin
  inherited;
  for i:=0 to FContainedRecords.Count-1 do FContainedRecords[i].ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount, SheetInfo, Forced, dSheet);
end;

procedure TEscherContainerRecord.AssignClientData(
  const aClientData: TBaseClientData);
begin
  LastRecord.AssignClientData(aClientData);
end;

procedure TEscherContainerRecord.ClearCopiedTo;
var
  i: integer;
begin
  inherited;
  for i:=0 to FContainedRecords.Count-1 do FContainedRecords[i].ClearCopiedTo;
end;

constructor TEscherContainerRecord.Create(const aEscherHeader: TEscherRecordHeader; const aDwgGroupCache: PEscherDwgGroupCache; const aDwgCache: PEscherDwgCache; const aParent: TEscherContainerRecord);
begin
  inherited;
  FContainedRecords:= TEscherRecordList.Create;
end;

destructor TEscherContainerRecord.Destroy;
begin
  FreeAndNil(FContainedRecords);
  inherited;
end;

function TEscherContainerRecord.DoCopyTo(const NewDwgCache: PEscherDwgCache; const RowOfs, ColOfs: integer; const dSheet: TObject): TEscherRecord;
begin
  Result:=inherited DoCopyTo(NewDwgCache, RowOfs, ColOfs, dSheet);
  (Result as TEscherContainerRecord).FContainedRecords.CopyFrom(FContainedRecords, NewDwgCache, RowOfs, ColOfs, dSheet);
end;

function TEscherContainerRecord.FindRec(const RecClass: ClassOfTEscherRecord): TEscherRecord;
var
  i: integer;
begin
  Result:=nil;
  for i:=0 to FContainedRecords.Count-1 do if FContainedRecords[i] is RecClass then
  begin
    Result:= FContainedRecords[i];
    exit;
  end;
end;

function TEscherContainerRecord.LastRecord: TEscherRecord;
begin
  if FContainedRecords.Count=0 then raise Exception.Create(ErrLoadingEscher);