tmsuxlsescher.pas

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

    FDgContainer:=aDrawing.FDgContainer.CopyTo(@FRecordCache, 0,0, dSheet) as TEscherContainerRecord;
    FRecordCache.Shape.Sort; // only here the values are loaded...
    if FRecordCache.Solver<>nil then FRecordCache.Solver.CheckMax(aDrawing.FRecordCache.Solver.MaxRuleId);

    FDrawingGroup.AddDwg;
  end;
  //MADE: change cache
end;

constructor TDrawing.Create(const aDrawingGroup: TDrawingGroup);
begin
  inherited Create;
  FDrawingGroup:=aDrawingGroup;
  FRecordCache.Destroying:=false;
end;

procedure TDrawing.DeleteRows(const aRow, aCount: word;
  const SheetInfo: TSheetInfo; const dSheet: TObject);
var i: integer;
begin
  if FRecordCache.Anchor=nil then exit;
  for i:= FRecordCache.Anchor.Count-1 downto 0 do
    if FRecordCache.Anchor[i].AllowDelete(aRow, aRow+aCount-1,0,Max_Columns+1)then
    begin
      if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);
      FRecordCache.Patriarch.ContainedRecords.Remove(FRecordCache.Anchor[i].FindRoot);
    end;

  ArrangeInsertRowsAndCols(aRow, -aCount, 0,0, SheetInfo, dSheet);
end;

procedure TDrawing.DeleteCols(const aCol, aCount: word;
  const SheetInfo: TSheetInfo; const dSheet: TObject);
var i: integer;
begin
  //MADE: delete cols
  //MADE: Arreglar los continues...
  //MADE: Conectores
  if FRecordCache.Anchor=nil then exit;
  for i:= FRecordCache.Anchor.Count-1 downto 0 do
    if FRecordCache.Anchor[i].AllowDelete(0, Max_Rows+1, aCol, aCol+aCount-1)then
    begin
      if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);
      FRecordCache.Patriarch.ContainedRecords.Remove(FRecordCache.Anchor[i].FindRoot);
    end;

  ArrangeInsertRowsAndCols(0,0,aCol, -aCount, SheetInfo, dSheet);
end;

destructor TDrawing.Destroy;
begin
  FRecordCache.Destroying:=true;
  Clear;
  inherited;
end;

function TDrawing.DrawingCount: integer;
begin
  if FRecordCache.Blip<>nil then Result:=FRecordCache.Blip.Count else Result:=0;
end;

function TDrawing.FindObjId(const ObjId: word): TEscherClientDataRecord;
var
  i: integer;
begin
  for i:=0 to FRecordCache.Obj.Count-1 do if FRecordCache.Obj[i].ObjId=ObjId then
  begin
    Result:=FRecordCache.Obj[i];
    exit;
  end;
  Result:=nil;
end;

function TDrawing.GetAnchor(const Index: integer): TClientAnchor;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].GetAnchor;
end;

procedure TDrawing.SetAnchor(const Index: integer; const aAnchor: TClientAnchor; const sSheet: TObject);
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  FRecordCache.Blip[index].SetAnchor(aAnchor, sSheet);
end;

procedure TDrawing.GetDrawingFromStream(const Index: integer; const Data: TStream; out DataType: TXlsImgTypes);
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  FRecordCache.Blip[index].GetImageFromStream(Data, DataType);
end;

function TDrawing.GetDrawingName(index: integer): UTF16String;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].ShapeName;
end;

function TDrawing.GetDrawingRow(index: integer): integer;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].Row;
end;

procedure TDrawing.InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, RowCount, FirstCol, LastCol, DestCol,
  ColCount: integer; const SheetInfo: TSheetInfo; const dSheet: TObject);
var
  i,k, myDestRow, myFirstRow, myLastRow, myDestCol, myFirstCol, myLastCol: integer;
begin
  if (FDgContainer=nil) or (FRecordCache.Anchor= nil) then exit;  //no drawings on this sheet

  if DestRow>FirstRow then
  begin
    myFirstRow:=FirstRow; myLastRow:=LastRow;
  end else
  begin
    myFirstRow:=FirstRow+RowCount*(LastRow-FirstRow+1);
    myLastRow:=LastRow+RowCount*(LastRow-FirstRow+1);
  end;

  if DestCol>FirstCol then
  begin
    myFirstCol:=FirstCol; myLastCol:=LastCol;
  end else
  begin
    myFirstCol:=FirstCol+ColCount*(LastCol-FirstCol+1);
    myLastCol:=LastCol+ColCount*(LastCol-FirstCol+1);
  end;

  //Insert cells
  ArrangeInsertRowsAndCols(DestRow, RowCount*(LastRow-FirstRow+1), DestCol, ColCount*(LastCol-FirstCol+1), SheetInfo, dSheet);

  //Copy the images
  //First the rows...
  myDestRow:=DestRow;
  for k:= 0 to RowCount-1 do
  begin
    FDgContainer.ClearCopiedTo;
    for i:= 0 to FRecordCache.Anchor.Count-1 do
      if FRecordCache.Anchor[i].AllowCopy(myFirstRow, myLastRow, 0, Max_Columns+1)then
      begin
         FRecordCache.Anchor[i].CopyDwg(myDestRow-myFirstRow,0, dSheet);
      end;
    inc(myDestRow, (LastRow-FirstRow+1));
    if FRecordCache.Solver<>nil then FRecordCache.Solver.ArrangeCopyRowsAndCols(dSheet);
  end;

  //Now the columns... as we already copied the rows, now we will make an array of images
  myDestCol:=DestCol;
  for k:= 0 to ColCount-1 do
  begin
    FDgContainer.ClearCopiedTo;
    for i:= 0 to FRecordCache.Anchor.Count-1 do
      if FRecordCache.Anchor[i].AllowCopy(0, Max_Rows+1, myFirstCol, myLastCol)then
      begin
         FRecordCache.Anchor[i].CopyDwg(0, myDestCol-myFirstCol, dSheet);
      end;
    inc(myDestCol, (LastCol-FirstCol+1));
    if FRecordCache.Solver<>nil then FRecordCache.Solver.ArrangeCopyRowsAndCols(dSheet);
  end;

end;

procedure TDrawing.CreateBasicDrawingInfo;
var
  EscherHeader: TEscherRecordHeader;
  Dg: TEscherDgRecord;
  SPRec: TEscherSpContainerRecord;
  SPgrRec:TEscherDataRecord;
  SP: TEscherSPRecord;
  DgId: integer;
  FirstId: Int64;
begin
  Assert (FDrawingGroup<>nil,'DrawingGroup can''t be nil');
  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;

  EscherHeader.Pre:=$F;
  EscherHeader.Id:=MsofbtDgContainer;
  EscherHeader.Size:=0;
  FDgContainer:=TEscherContainerRecord.Create(EscherHeader, FDrawingGroup.RecordCache, @FRecordCache ,nil);
  FDrawingGroup.AddDwg;

  //Add required records...
  FDrawingGroup.RecordCache.Dgg.GetNewDgIdAndCluster(DgId, FirstId);
  Dg:=TEscherDgRecord.CreateFromData(0, DgId, FirstId, FDrawingGroup.RecordCache, @FRecordCache, FDgContainer);
  FDgContainer.ContainedRecords.Add(Dg);

  EscherHeader.Pre:=$F;
  EscherHeader.Id:=MsofbtSpgrContainer;
  EscherHeader.Size:=0;
  FRecordCache.Patriarch:= TEscherSpgrContainerRecord.Create(EscherHeader, FDrawingGroup.RecordCache, @FRecordCache, FDgContainer);
  FDgContainer.ContainedRecords.Add(FRecordCache.Patriarch);

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

  EscherHeader.Id:=MsofbtSpgr;
  EscherHeader.Pre:=$1;
  EscherHeader.Size:=16;
  SPgrRec:=TEscherDataRecord.Create(EscherHeader, FDrawingGroup.RecordCache, @FRecordCache, FRecordCache.Patriarch);
  SPgrRec.LoadedDataSize:=EscherHeader.Size;
  SPgrRec.ClearData;
  SPRec.ContainedRecords.Add(SPgrRec);

  SP:=TEscherSPRecord.CreateFromData($2,FRecordCache.Dg.IncMaxShapeId, $5 , FDrawingGroup.RecordCache, @FRecordCache, SPRec);
  SPRec.ContainedRecords.Add(SP);


end;

procedure TDrawing.AddImage(Data: ByteArray; DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType; const sSheet: TObject);
var
  SPRec: TEscherSpContainerRecord;
  AnchorRec: TEscherClientAnchorRecord;
  RecordHeader: TEscherRecordHeader;
  ClientAnchor: TClientAnchor;
  ClientData: TEscherClientDataRecord;
  SP: TEscherSPRecord;
  OPTRec:TEscherOPTRecord;
begin
  if Length(Data)=0 then
  begin
    Data:=EmptyBmp;
    DataType:=xli_Bmp;
  end;
  if (FDgContainer=nil) or (FRecordCache.Anchor= nil) then //no drawings on this sheet
    CreateBasicDrawingInfo;

  if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);

  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);
  SPRec.LoadedDataSize:=RecordHeader.Size;

  SP:=TEscherSPRecord.CreateFromData($04B2, FRecordCache.Dg.IncMaxShapeId, $A00 , FDrawingGroup.RecordCache, @FRecordCache, SPRec);
  SPRec.ContainedRecords.Add(SP);

  OPTRec:=TEscherOPTRecord.CreateFromDataImg(Data, DataType, Properties.FileName, FDrawingGroup.RecordCache, @FRecordCache, SPRec);
  SPRec.ContainedRecords.Add(OPTRec);

  RecordHeader.Id:=MsofbtClientAnchor;
  RecordHeader.Pre:=0;
  RecordHeader.Size:=SizeOf(TClientAnchor);
  case Anchor of
    at_MoveAndResize: ClientAnchor.Flag:=00;
    at_DontMoveAndDontResize: ClientAnchor.Flag:=03;
    else ClientAnchor.Flag:=02;
  end; //case

  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);
  SPRec.ContainedRecords.Add(AnchorRec);


  RecordHeader.Id:=MsofbtClientData;
  RecordHeader.Pre:=0;
  RecordHeader.Size:=0;
  ClientData:= TEscherClientDataRecord.Create(RecordHeader, FDrawingGroup.RecordCache, @FRecordCache, SPRec);
  ClientData.AssignClientData(TMsObj.CreateEmptyImg(FRecordCache.MaxObjId));
  ClientData.LoadedDataSize:=RecordHeader.Size;
  SPRec.ContainedRecords.Add(ClientData);
  FRecordCache.Patriarch.ContainedRecords.Add(SPRec);
end;

procedure TDrawing.RemoveAutoFilter();
var
  i: Int32;
  obj0: TEscherClientDataRecord;
  ClientData: TMsObj;
begin
  if FRecordCache.Obj = nil then
    exit;

  if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);

  for i := FRecordCache.Obj.Count - 1 downto 0 do
  begin
    obj0 := FRecordCache.Obj[i];
    if obj0.ClientData = nil then continue;

    if not (obj0.ClientData is TMsObj) then continue;

    ClientData := TMsObj(obj0.ClientData);

    if ClientData.IsAutoFilter then
    begin
      FRecordCache.Patriarch.ContainedRecords.Remove(obj0.FindRoot);
    end;
  end;
end;

procedure TDrawing.AddAutoFilter(const Row: Int32; const Col1: Int32; const Col2: Int32; const sSheet: TObject);
var
  i: Int32;
begin
  for i := Col1 to Col2 do
  begin
    AddAutoFilter(Row, i, sSheet);
  end;
end;

procedure TDrawing.AddAutoFilter(const Row: Int32; const Col: Int32; const sSheet: TObject);
var