escher2.pas

一个经典的读写Excel的控件

  i: integer;
begin
  Sz := PrivateSize;
  if WriteMSODRAWING then
    Stream.WriteHeader(BIFFRECID_MSODRAWING,Sz);
  WriteMSOHeader(Stream,$0F,$0000,MSO_SPGRCONTAINER,Size - SizeOf(TMSOHeader));

  WriteMSOHeader(Stream,$0F,$0000,MSO_SPCONTAINER,PrivateSize - (SizeOf(TMSOHeader) * 2));

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

  WriteMSOHeader(Stream,$02,FShapeType,MSO_SP,SizeOf(TMSORecSP));
  Stream.Write(FSpId,SizeOf(FSpId));
  Stream.Write(FOptions,SizeOf(FOptions));

  FOPT.WriteToStream(Stream,PBuf);
  if FUnknown <> Nil then
    FUnknown.Write(Stream);
  WriteMSOHeader(Stream,$00,$0000,MSO_CLIENTANCHOR,SizeOf(TMSORecCLIENTANCHOR));
  Stream.Write(FCLIENTANCHOR,SizeOf(TMSORecCLIENTANCHOR));
  WriteMSOHeader(Stream,$00,$0000,MSO_CLIENTDATA,0);

  Stream.WriteHeader(BIFFRECID_OBJ,FOBJ.Size);
  FOBJ.WriteAllRecs(Stream);

  if FInterface <> Nil then
    FInterface.Write(Stream);
  for i := 0 to FList.Count - 1 do
    Items[i].WriteToSTream(Stream,PBuf,True);
end;

{ TEscherDrawing }

procedure TEscherDrawing.Clear;
begin
  FGroup.Clear;
  if FDgId > 0 then
    FParent.DeleteDrawing(FDgId);
  FDgId := 0;
end;

constructor TEscherDrawing.Create(Parent: TEscherGroup; Fonts: TXFonts; InternalNames: TInternalNames);
begin
  FParent := Parent;
  FFonts := Fonts;
  FInternalNames := InternalNames;
  FGroup := TShapeGroup.Create(Self);
end;

destructor TEscherDrawing.Destroy;
begin
  FGroup.Free;
  FSolverContainer.Free;
  if FDgId > 0 then
    FParent.DeleteDrawing(FDgId);
  inherited;
end;

function TEscherDrawing.ReadRoot(Stream: TXLSStream; PBuf: PByteArray): integer;
var
  i,Count: longword;
  Header: TMSOHeader;
begin
  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT <> MSO_DG then
    raise Exception.Create('Expected record missing: DG');

  Stream.Read(FDG,SizeOf(TMSORecDG));
  FDgId := (Header.VerInst shr 4) and $0FFF;
  FParent.AssignDrawing(Self);

  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT = MSO_REGROUPITEMS then begin
    Count := (Header.VerInst shr 4) and $0FFF;
    SetLength(FFileReGroupItems,Count);
    for i := 0 to Count - 1 do
      Stream.Read(FFileReGroupItems[i],SizeOf(TMSOFileReGroupItem));
    Stream.Read(Header,SizeOf(TMSOHeader));
  end;
  if Header.FBT <> MSO_SPGRCONTAINER then
    raise Exception.Create('Expected record missing: SPGRCONTAINER');
  Result := Header.Length;

  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT <> MSO_SPCONTAINER then
    raise Exception.Create('Expected record missing: SPCONTAINER');
  Dec(Result,Header.Length + SizeOf(TMSOHeader));

  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT <> MSO_SPGR then
    raise Exception.Create('Expected record missing: SPGR');
  Stream.Read(FGroup.FSPGR,SizeOf(TMSORecSPGR));

  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT <> MSO_SP then
    raise Exception.Create('Expected record missing: SP');
  Stream.Read(FGroup.FSpId,SizeOf(FGroup.FSpId));
  Stream.Read(FGroup.FOptions,SizeOf(FGroup.FOptions));
  if (FGroup.FOptions and SpOptPatriarch) = 0 then
    raise Exception.Create('SP is not root');
end;

procedure TEscherDrawing.ReadOBJ(Shape: TShape; Stream: TXLSStream; PBuf: PByteArray);
var
  Len: integer;
  Header: TBIFFHeader;

function GetLbsSize: integer;
var
  p: integer;
begin
  p := Stream.Pos;
  Stream.Read(PBuf[0],8);
  Stream.Read(PBuf[8],PWordArray(PBuf)[1]);
  Stream.Read(PBuf[8 + PWordArray(PBuf)[1]],7);
  // Two extra bytes for invalid END record
  if (PWordArray(@PBuf[8 + PWordArray(PBuf)[1] + 5])[0] and $0030) <> 0 then
    Stream.Read(PBuf[8 + PWordArray(PBuf)[1] + 7],PWordArray(@PBuf[8 + PWordArray(PBuf)[1] + 1])[0] + 2)
  else
    Stream.Read(PBuf[8 + PWordArray(PBuf)[1] + 7],2);
  Result := Stream.Pos - p - 2;
end;

begin
  Stream.ReadHeader(Header);
  // This may occure if the shape is deleted. Fix it.
  if Header.RecID <> BIFFRECID_OBJ then
    raise Exception.Create('Expected record missing: OBJ');
  Len := Header.Length;
  while Len > 0 do begin
    Stream.ReadHeader(Header);
    // This record always has invalid length.
    // As it always seems to be the second last record (before OBJREC_END),
    // calculate the length.
    if Header.RecID = OBJREC_LBSDATA then begin
      Header.Length := Len - (SizeOf(TBIFFHeader) + 2);
      Stream.Read(PBuf^,Header.Length);
      Shape.FOBJ.AddRec(Header,PBuf);

      // LBS do not have a valid END record. It is just two bytes of zero (no length part).
      Header.RecID := OBJREC_END;
      Header.Length := 0;
      Stream.Read(PBuf^,2);
      Shape.FOBJ.AddRec(Header,PBuf);
      Break;
    end;
    if not (Header.RecID in [OBJREC_END,OBJREC_MACRO..OBJREC_CMO]) then
      raise Exception.CreateFmt('Unknown OBJ record %.2X',[Header.RecId]);
    // OBJREC_END may have invalid length...
    if Header.RecID = OBJREC_END then begin
      Header.Length := 0;
      Shape.FOBJ.AddRec(Header,PBuf);
      Break;
    end;
    if Header.RecID <> OBJREC_LBSDATA then
      Stream.Read(PBuf^,Header.Length);
    Dec(Len,Header.Length + SizeOf(TBIFFHeader));
    if Header.RecID = OBJREC_CMO then begin
      if PObjCMO(PBuf).ObjId > FMaxObjId then
        FMaxObjId := PObjCMO(PBuf).ObjId;
    end;
    Shape.FOBJ.AddRec(Header,PBuf);
  end;
{
  if Len <> 0 then
    raise Exception.Create('Error while reading OBJ. Length <> 0');
}
end;

procedure TEscherDrawing.LoadFromStream(Stream: TXLSStream; PBuf: PByteArray);
var
  Count: integer;
  Header: TMSOHeader;
  BIFFHeader: TBIFFHeader;

procedure ReadMSODRAWING;
begin
  Stream.Read(BIFFHeader,SizeOf(TBIFFHeader));
  // BUG in excel: when writing notes MSODRAWING may be replaced with CONTINUE
  if not (BIFFHeader.RecID in [BIFFRECID_MSODRAWING,BIFFRECID_CONTINUE]) then
    raise Exception.Create('Expected record missing: MSODRAWING');
end;

procedure ReadShape(Group: TShapeGroup; GroupLen: integer);
var
  V1,V2: longword;
  Instance: word;
  Len,ChildLen: integer;
  Shape: TShape;
  SPGR: TMSORecSPGR;
begin
  while GroupLen > 0 do begin
    Inc(Count);
    Stream.Read(Header,SizeOf(TMSOHeader));
    Len := Header.Length;
    ChildLen := Len;
    if Header.FBT = MSO_SPGRCONTAINER then begin
      ChildLen := Header.Length;
      Stream.Read(Header,SizeOf(TMSOHeader));
      Len := Header.Length;
      Dec(ChildLen,Len + SizeOf(TMSOHeader));
    end;
    Shape := Nil;
    Dec(GroupLen,Len + SizeOf(TMSOHeader));
    if Header.FBT <> MSO_SPCONTAINER then
      raise Exception.Create('Expected record missing: SPCONTAINER');
    while Len > 0 do begin
      Stream.Read(Header,SizeOf(TMSOHeader));
      Instance := (Header.VerInst shr 4) and $0FFF;
      case Header.FBT of
        MSO_SPGR: begin
          Stream.Read(SPGR,SizeOf(TMSORecSPGR));
        end;
        MSO_SP: begin
          Stream.Read(V1,SizeOf(V1));
          Stream.Read(V2,SizeOf(V2));
          if (V2 and SpOptGroup) = SpOptGroup then begin
            Shape := TShapeGroup.Create(Self);
            TShapeGroup(Shape).FSPGR := SPGR;
          end
          else if (V2 and SpOptChild) = SpOptChild then
            Shape := TShapeChildAnchor.Create
          else
            Shape := TShapeClientAnchor.Create;
          Shape.FSpId := V1;
          Shape.FOptions := V2;
          Shape.FShapeType := Instance;
        end;
        MSO_OPT: begin
          Shape.FOPT.LoadFromStream(Stream,Header.Length,PBuf,Instance);
        end;
        MSO_CHILDANCHOR: begin
          if not (Shape is TShapeChildAnchor) then
            raise Exception.Create('CHILDANCHOR when shape not is ChildAnchor');
          Stream.Read(TShapeChildAnchor(Shape).FCHILDANCHOR,SizeOf(TMSORecCHILDANCHOR));
        end;
        MSO_CLIENTANCHOR: begin
          if not (Shape is TShapeClientAnchor) then
            raise Exception.Create('CLIENTANCHOR when shape not is ClientAnchor');
          Stream.Read(TShapeClientAnchor(Shape).FCLIENTANCHOR,SizeOf(TMSORecCLIENTANCHOR));
        end;
        MSO_CLIENTDATA: begin
          if Header.Length > 0 then
            raise Exception.Create('Size of CLIENTDATA > 0');
          // Not sure if this is the best place to read OBJ...
          ReadOBJ(Shape,Stream,PBuf);
          case PObjCMO(@Shape.FOBJ[0].Data).ObjType of
            OBJTYPE_COMMENT: begin
              Shape.FInterface := TShapeOutsideMsoNote.Create(0);
              Shape.FInterface.Read(Stream,PBuf);
              Dec(Len,SizeOf(TMSOHeader));
            end;
            OBJTYPE_TEXT: begin
              Shape.FInterface := TShapeOutsideMsoBaseText.Create(0);
              Shape.FInterface.Read(Stream,PBuf);
              Dec(Len,SizeOf(TMSOHeader));
            end;
            OBJTYPE_BUTTON: begin
              Shape.FInterface := TShapeControlButton.Create(0,Self);
              if Shape.FInterface.ParseOBJ(Shape.FOBJ) then
                Shape.FOBJ.Clear;
              Shape.FInterface.Read(Stream,PBuf);
              Dec(Len,SizeOf(TMSOHeader));
            end;
            OBJTYPE_CHART: begin
              Shape.FInterface := TShapeOutsideMsoChart.Create(0,FParent,FFonts);
              Shape.FInterface.Read(Stream,PBuf);
            end;
            OBJTYPE_LIST_BOX: begin
              Shape.FInterface := TShapeControlListBox.Create(0);
              if Shape.FInterface.ParseOBJ(Shape.FOBJ) then
                Shape.FOBJ.Clear;
            end;
            OBJTYPE_COMBO_BOX: begin
              Shape.FInterface := TShapeControlComboBox.Create(0);
              if Shape.FInterface.ParseOBJ(Shape.FOBJ) then
                Shape.FOBJ.Clear;
            end;
            else begin
              if Shape.FOPT.TxId <> 0 then begin
                Shape.FInterface := TShapeOutsideMsoBaseText.Create(0);
                Shape.FInterface.Read(Stream,PBuf);
                Dec(Len,SizeOf(TMSOHeader));
              end;
            end;
          end;
        end;
        else begin
          if Shape.FUnknown = Nil then
            Shape.FUnknown := TMSORecords.Create;
          Stream.Read(PBuf^,Header.Length);
          Shape.FUnknown.Add(Header,PBuf);
        end;
      end;
      Dec(Len,Header.Length + SizeOf(TMSOHeader));
    end;
    if Len <> 0 then
      raise Exception.Create('Error while reading Shape. Length <> 0');
    Group.Add(Shape);
    if Assigned(FFileReadShapeEvent) then
      FFileReadShapeEvent(Self,Shape);
    if GroupLen > 0 then
      ReadMSODRAWING;
    if Shape is TShapeGroup then begin
      Dec(GroupLen,ChildLen + SizeOf(TMSOHeader));
      ReadShape(TShapeGroup(Shape),ChildLen);
      if GroupLen > 0 then
        ReadMSODRAWING;
    end;
  end;
  if GroupLen <> 0 then
    raise Exception.Create('Error while reading Shape. Group Length <> 0');
end;

begin
  Stream.Read(Header,SizeOf(TMSOHeader));
  if Header.FBT <> MSO_DGCONTAINER then
    raise Exception.Create('Expected record missing: DGCONTAINER');
  FMaxObjId := 0;
  Count := 0;
  try
    ReadShape(FGroup,ReadRoot(Stream,PBuf));
    if Stream.PeekHeader = BIFFRECID_MSODRAWING then begin
      Stream.Read(BIFFHeader,SizeOf(TBIFFHeader));
      FSolverContainer := TMSORecords.Create;
      while BIFFHeader.Length > 0 do begin
        Stream.Read(Header,SizeOf(TMSOHeader));
        if (Header.VerInst and $0F) = $0F then
          Dec(BIFFHeader.Length,SizeOf(TMSOHeader))
        else begin
          Stream.Read(PBuf^,Header.Length);
          Dec(BIFFHeader.Length,Header.Length + SizeOf(TMSOHeader));
        end;
        FSolverContainer.Add(Header,PBuf);
      end;
    end;
  except
    on E: Exception do
      raise Exception.CreateFmt('Error on reading shape #%d' + #13 + E.Message,[Count]);
  end;
end;

procedure TEscherDrawing.SetNoteData(Col, Row, Options, ObjId: word; Author: WideString);
var
  i: integer;
begin
  for i := 0 to FGroup.Count - 1 do begin
    if (FGroup[i].FInterface <> Nil) and (FGroup[i].FInterface is TShapeOutsideMsoNote) and (PObjCMO(@FGroup[i].FOBJ[0].Data).ObjId = ObjId) then begin
      TShapeOutsideMsoNote(FGroup[i].FInterface).CellCol := Col;
      TShapeOutsideMsoNote(FGroup[i].FInterface).CellRow := Row;
      TShapeOutsideMsoNote(FGroup[i].FInterface).Options := Options;
      TShapeOutsideMsoNote(FGroup[i].FInterface).Author := Author;
      Exit;
    end;
  end;
  raise Exception.CreateFmt('Can not find shape for note #%d',[ObjId]);
end;

// 040527
procedure TEscherDrawing.SaveToStream(Stream: TXLSStream; PBuf: PByteArray {; DrawingId: integer});
var
  i,Sz: integer;

// WriteWideString in TXLSStream don't writes the unicode prefix byte on
// empty strings. This is required for notes.
procedure X_WriteWideString(Value: WideString);
begin
  Stream.WWord(Length(Value));
  if Value <> '' then begin
    Stream.WByte(1);
    Stream.Write(Pointer(Value)^,Length(Value) * 2);
  end
  else
    Stream.WByte(0);
end;

procedure WriteRoot;
var
  i,FileSz: integer;
begin
        // DGCONTAINER
  Sz := SizeOf(TMSOHeader) +
        // DG
        SizeOf(TMSOHeader) + SizeOf(TMSORecDG) +
        // REGROUPITEMS
        // Conditional, added below.
        // SPGRCONTAINER
        SizeOf(TMSOHeader) +
        // SPCONTAINER
        SizeOf(TMSOHeader) +
        // SPGR
        SizeOf(TMSOHeader) + SizeOf(TMSORecSPGR) +
        // SP
        SizeOf(TMSOHeader) + SizeOf(TMSORecSP);
  // REGROUPITEMS