escher2.pas

一个经典的读写Excel的控件

  if Length(FFileReGroupItems) > 0 then
    Inc(Sz,SizeOf(TMSOHeader) + (Length(FFileReGroupItems) * SizeOf(TMSOFileReGroupItem)));
  FileSz := Sz;
  if FGroup.Count > 0 then begin
    if FGroup[0] is TShapeGroup then
      Inc(FileSz,TShapeGroup(FGroup[0]).PrivateSize)
    else
      Inc(FileSz,FGroup[0].Size);
  end;
  if (FGroup.Count > 0) and (FGroup[0].FInterface is TShapeOutsideMsoBaseText) then
    Stream.WriteHeader(BIFFRECID_MSODRAWING,FileSz - SizeOf(TMSOHeader))
  else
    Stream.WriteHeader(BIFFRECID_MSODRAWING,FileSz);

  for i := 0 to FGroup.Count - 1 do
    Inc(Sz,FGroup[i].Size);

  Dec(Sz,SizeOf(TMSOHeader));
  if FSolverContainer <> Nil then
    WriteMSOHeader(Stream,$0F,$0000,MSO_DGCONTAINER,Sz + FSolverContainer.Size)
  else
    WriteMSOHeader(Stream,$0F,$0000,MSO_DGCONTAINER,Sz);
  Dec(Sz,SizeOf(TMSOHeader));

  WriteMSOHeader(Stream,$00,FDgId,MSO_DG,SizeOf(TMSORecDG));

  // 040523
  FDG.ShapeCount_ := 1 + ShapeCount;
  Stream.Write(FDG,SizeOf(TMSORecDG));

  Dec(Sz,SizeOf(TMSOHeader) + SizeOf(TMSORecDG));

  if Length(FFileReGroupItems) > 0 then begin
    WriteMSOHeader(Stream,$00,Length(FFileReGroupItems),MSO_REGROUPITEMS,Length(FFileReGroupItems) * SizeOf(TMSOFileReGroupItem));
    for i := 0 to High(FFileReGroupItems) do
      Stream.Write(FFileReGroupItems[i],SizeOf(TMSOFileReGroupItem));
    Dec(Sz,SizeOf(TMSOHeader) + (Length(FFileReGroupItems) * SizeOf(TMSOFileReGroupItem)));
  end;

  WriteMSOHeader(Stream,$0F,$0000,MSO_SPGRCONTAINER,Sz);

  Sz := SizeOf(TMSOHeader) + SizeOf(TMSORecSPGR) +
        SizeOf(TMSOHeader) + SizeOf(TMSORecSP);
  WriteMSOHeader(Stream,$0F,$0000,MSO_SPCONTAINER,Sz);

  WriteMSOHeader(Stream,$01,$0000,MSO_SPGR,SizeOf(TMSORecSPGR));
  Stream.Write(FGroup.FSPGR,SizeOf(TMSORecSPGR));

  WriteMSOHeader(Stream,$02,$0000,MSO_SP,SizeOf(TMSORecSP));
  Stream.Write(FGroup.SpId,SizeOf(FGroup.SpId));
  Stream.Write(FGroup.Options,SizeOf(FGroup.Options));
end;

begin
  WriteRoot;
  for i := 0 to FGroup.Count - 1 do
    FGroup[i].WriteToStream(Stream,PBuf,i > 0);

  if FSolverContainer <> Nil then begin
    Sz := FSolverContainer.Size;
    Stream.WriteHeader(BIFFRECID_MSODRAWING,Sz);
    FSolverContainer.Write(Stream);
  end;

  for i := 0 to FGroup.Count - 1 do begin
    if FGroup[i].FInterface is TShapeOutsideMsoNote then begin
      Stream.WriteHeader(BIFFRECID_NOTE,TRecNOTE_FIXEDLEN + 1 + 2 + Length(TShapeOutsideMsoNote(FGroup[i].FInterface).Author) * 2);
      Stream.Write(TShapeOutsideMsoNote(FGroup[i].FInterface).CellRow,2);
      Stream.Write(TShapeOutsideMsoNote(FGroup[i].FInterface).CellCol,2);
      Stream.Write(TShapeOutsideMsoNote(FGroup[i].FInterface).Options,2);
      Stream.Write(PObjCMO(@FGroup[i].FOBJ[0].Data).ObjId,2);
      X_WriteWideString(TShapeOutsideMsoNote(FGroup[i].FInterface).Author);
    end;
  end;
end;

function TEscherDrawing.ShapeCount: integer;
begin
  Result := FGroup.Count;
end;

procedure TEscherDrawing.AssignBlipIds(Blips: TList);

procedure SetId(Shape: TShape);
var
  i,j,Id: integer;
begin
  if Shape is TShapeGroup then begin
    for i := 0 to TShapeGroup(Shape).Count - 1 do
      SetId(TShapeGroup(Shape)[i]);
  end
  else begin
    Id := Shape.FOPT.BlipId;
    if Id >= 0 then begin
      j := Blips.IndexOf(Pointer(Id - 1));
      if j < 0 then
        raise Exception.CreateFmt('Can not find Blip Id #%d',[Id]);
      Shape.FOPT.SetBlipId(j + 1);
    end;
  end;
end;

begin
  SetId(FGroup);
end;

function TEscherDrawing.AddTextBox: TShapeClientAnchor;
var
  PBuf: PByteArray;
  Header: TBIFFHeader;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptTextBox;
  Result.FInterface := TShapeOutsideMsoBaseText.Create(GetObjId);

  TShapeOutsideMsoBaseText(Result.FInterface).SetDefaultTxo;

  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt;

  Result.FCLIENTANCHOR.Col1 := 1;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 3;
  Result.FCLIENTANCHOR.Row2 := 5;

  Result.FOPT.AddValue(msooptLTxid,GetTxId);
  Result.FOPT.AddValue(msooptTxdir,2);
  Result.FOPT.AddValue(msooptFFitTextToShape,$00080008);
  Result.FOPT.AddValue(msooptFillColor,$08000041);
  Result.FOPT.AddValue(msooptLineColor,$08000040);
  Result.FOPT.FItemCount := Result.FOPT.Count;

  FGroup.Add(Result);
  // 040523
  // Inc(FDG.ShapeCount);
  GetMem(PBuf,MAXRECSZ_97);
  try
    Header.RecID := OBJREC_CMO;
    Header.Length := SizeOf(TObjCMO);
    FillChar(PBuf^,SizeOf(TObjCMO),#0);
    PObjCMO(PBuf).ObjType := OBJTYPE_TEXT;
    PObjCMO(PBuf).ObjId := GetObjId;
    PObjCMO(PBuf).Options := $6011;
    Result.FOBJ.AddRec(Header,PBuf);

    Header.RecID := OBJREC_END;
    Header.Length := 0;
    Result.FOBJ.AddRec(Header,PBuf);
  finally
    FreeMem(PBuf);
  end;
end;

function TEscherDrawing.AddBasic: TShapeClientAnchor;
var
  PBuf: PByteArray;
  Header: TBIFFHeader;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptLine;
  Result.FInterface := Nil;
  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt {+ SpOptFlipH + SpOptFlipV};

  Result.FCLIENTANCHOR.Col1 := 1;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 3;
  Result.FCLIENTANCHOR.Row2 := 5;

  Result.FOPT.AddValue(msooptFFitTextToShape,$00080008);
  Result.FOPT.AddValue(msooptShapePath,msoshapeComplex);
  Result.FOPT.AddValue(msooptFFillOk,$00010000);
  Result.FOPT.AddValue(msooptFNoFillHitTest,$00100000);
  Result.FOPT.AddValue(msooptLineColor,$08000040);
  Result.FOPT.AddValue(msooptFillColor,$08000041);
  Result.FOPT.AddValue(msooptLineEndArrowHead,msolineArrowEnd);
  Result.FOPT.AddValue(msooptFNoLineDrawDash,$00100010);
  Result.FOPT.FItemCount := Result.FOPT.Count;

  FGroup.Add(Result);
  // 040523
  // Inc(FDG.ShapeCount);
  GetMem(PBuf,MAXRECSZ_97);
  try
    Header.RecID := OBJREC_CMO;
    Header.Length := SizeOf(TObjCMO);
    FillChar(PBuf^,SizeOf(TObjCMO),#0);
    PObjCMO(PBuf).ObjType := OBJTYPE_LINE;
    PObjCMO(PBuf).ObjId := GetObjId;
    PObjCMO(PBuf).Options := $6011;
    Result.FOBJ.AddRec(Header,PBuf);

    Header.RecID := OBJREC_END;
    Header.Length := 0;
    Result.FOBJ.AddRec(Header,PBuf);
  finally
    FreeMem(PBuf);
  end;
end;

function TEscherDrawing.MaxSpId: integer;
begin
  Result := FDG.CurSpId;
end;

procedure TEscherDrawing.SetRootData;
begin
  if ShapeCount <= 0 then begin
    FParent.AddDrawing(Self,FDgId,FDG.CurSpId);
    FGroup.FOptions := SpOptGroup + SpOptPatriarch;
    FGroup.FSpId := FDG.CurSpId;
    // 040523
    // Inc(FDG.ShapeCount);
    Inc(FDG.CurSpId);
  end
  else
    FParent.UpdateDrawing(FDgId);
end;

function TEscherDrawing.GetSpId: integer;
begin
  Result := FDG.CurSpId;
  Inc(FDG.CurSpId);
end;

procedure TEscherDrawing.DeleteShape(SpId: integer);
begin
  FGroup.DeleteBySpId(SpId);
  // 040523
  //  Dec(FDG.ShapeCount);
  if FGroup.Count <= 0 then begin
    FParent.DeleteDrawing(FDgId);
    FDgId := 0;
  end
  else
    FParent.UpdateDrawing(FDgId);
end;

function TEscherDrawing.AddListBox: TShapeClientAnchor;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptHostControl;
  Result.FInterface := TShapeControlListBox.Create(GetObjId);
  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt;

  Result.FCLIENTANCHOR.Col1 := 3;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 5;
  Result.FCLIENTANCHOR.Row2 := 5;

  Result.FOPT.AddValue(msooptFLockAgainstGrouping,$01040104);
  Result.FOPT.AddValue(msooptFFitTextToShape,$00080008);
  Result.FOPT.AddValue(msooptLineColor,$08000040);
  Result.FOPT.AddValue(msooptFNoLineDrawDash,$00100010);
  Result.FOPT.FItemCount := Result.FOPT.Count;

  FGroup.Add(Result);
  // 040523
  // Inc(FDG.ShapeCount);
end;

function TEscherDrawing.AddComboBox: TShapeClientAnchor;
begin
  Result := AddListBox;
  TShapeControlListBox(Result.FInterface).FIsComboBox := True;
  Result.FCLIENTANCHOR.Row2 := Result.FCLIENTANCHOR.Row1 + 1;
end;

function TEscherDrawing.AddButton: TShapeClientAnchor;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptHostControl;
  Result.FInterface := TShapeControlButton.Create(GetObjId,Self);
  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt;

  TShapeOutsideMsoBaseText(Result.FInterface).SetDefaultTxo;
  TShapeOutsideMsoBaseText(Result.FInterface).FText := 'Button';

  Result.FCLIENTANCHOR.Col1 := 3;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 4;
  Result.FCLIENTANCHOR.Row2 := 2;

  Result.FOPT.AddValue(msooptFLockAgainstGrouping,$01040104);
  Result.FOPT.AddValue(msooptLTxId,GetTxId);
  Result.FOPT.AddValue(msooptWrapText,$00000001);
  Result.FOPT.AddValue(msooptTxDir,$00000002);
  Result.FOPT.AddValue(msooptFFitTextToShape,$001A0008);
  Result.FOPT.AddValue(msooptFillColor,$08000043);
  Result.FOPT.AddValue(msooptFillBackColor,$08000043);
  Result.FOPT.AddValue(msooptFNoFillHitTest,$00110011);
  Result.FOPT.AddValue(msooptLineColor,$08000040);
  Result.FOPT.AddValue(msooptFPrint,$00080008);
  Result.FOPT.FItemCount := Result.FOPT.Count;

  FGroup.Add(Result);
  // 040523
  // Inc(FDG.ShapeCount);
end;

function TEscherDrawing.AddNote: TShapeClientAnchor;
var
  PBuf: PByteArray;
  Header: TBIFFHeader;
  Font,Fnt: TXFont;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptTextBox;
  Result.FInterface := TShapeOutsideMsoNote.Create(GetObjId);

  TShapeOutsideMsoNote(Result.FInterface).SetDefaultTxo;
  Font := TXFont.Create;
  try
    Font.Size20 := 8 * 20;
    Fnt := FFonts.AddFind(Font);
    TShapeOutsideMsoNote(Result.FInterface).FTXORuns[0].FontIndex := Fnt.Index;
  finally
//    Font.Free;
  end;

  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt;

  Result.FCLIENTANCHOR.Col1 := 1;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 3;
  Result.FCLIENTANCHOR.Row2 := 5;

  Result.FOPT.AddValue(msooptLTxid,GetTxId);
  Result.FOPT.AddValue(msooptTxdir,2);
  Result.FOPT.AddValue(msooptFFitTextToShape,$00080008);
  Result.FOPT.AddValue($0158,$00000000);
  Result.FOPT.AddValue(msooptFillColor,$08000050);
  Result.FOPT.AddValue(msooptFillBackColor,$08000050);
  Result.FOPT.AddValue(msooptFNoFillHitTest,$00100010);
  Result.FOPT.AddValue(msooptShadowColor,$00000000);
  Result.FOPT.AddValue(msooptShadowObscured,$00030003);
  Result.FOPT.AddValue(msooptFPrint,$00020002);
  Result.FOPT.FItemCount := Result.FOPT.Count;

  FGroup.Add(Result);
  // 040523
  // Inc(FDG.ShapeCount);
  GetMem(PBuf,MAXRECSZ_97);
  try
    Header.RecID := OBJREC_CMO;
    Header.Length := SizeOf(TObjCMO);
    FillChar(PBuf^,SizeOf(TObjCMO),#0);
    PObjCMO(PBuf).ObjType := OBJTYPE_COMMENT;
    PObjCMO(PBuf).ObjId := GetObjId;
    PObjCMO(PBuf).Options := $4011;
    Result.FOBJ.AddRec(Header,PBuf);

    Header.RecID := OBJREC_NTS;
    Header.Length := 0;
    Result.FOBJ.AddRec(Header,PBuf);

    Header.RecID := OBJREC_END;
    Header.Length := 0;
    Result.FOBJ.AddRec(Header,PBuf);
  finally
    FreeMem(PBuf);
  end;
end;

function TEscherDrawing.AddAutoShape: TShapeClientAnchor;
var
  PBuf: PByteArray;
  Header: TBIFFHeader;
begin
  SetRootData;

  Result := TShapeClientAnchor.Create;
  Result.FShapeType := msosptSun;
  Result.FInterface := Nil;
  Result.FSpId := GetSpId;
  Result.FOptions := SpOptHaveAnchor + SpOptHaveSpt {+ SpOptFlipH + SpOptFlipV};

  Result.FCLIENTANCHOR.Col1 := 1;
  Result.FCLIENTANCHOR.Row1 := 1;
  Result.FCLIENTANCHOR.Col2 := 2;
  Result.FCLIENTANCHOR.Row2 := 5;

  Result.FOPT.AddValue(msooptFFitTextToShape,$00080008);