recordstoragechart2.pas

一个经典的读写Excel的控件

end;

function TChartRecord.FindRecordChilds(Id: integer): boolean;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if Items[i].Count > 0 then begin
      Result := Items[i].FindRecordChilds(Id);
      if Result then
        Exit;
    end;
    if Items[i].RecId = Id then begin
      Result := True;
      Exit;
    end;
  end;
  Result := False;
end;

function TChartRecord.GetItems(Index: integer): TChartRecord;
begin
  Result := TChartRecord(Inherited Items[Index]);
end;

function TChartRecord.InsertRecord(Index: integer; RecId, Length: word; IsUpdate: boolean = False): TChartRecord;
begin
  if Index < 0 then
    Index := Count;
  if IsUpdate then
    Insert(Index,TChartRecordUpdate.Create(Self,RecId,Length))
  else
    Insert(Index,TChartRecord.Create(Self,RecId,Length));
  Result := Items[Index];
end;

function TChartRecord.LastRec: TChartRecord;
begin
  if Count <= 0 then
    raise Exception.Create('Parent record is missing in chart');
  Result := Items[Count - 1];
end;

procedure TChartRecord.Read(Stream: TXLSStream; PBuf: PByteArray; Fonts: TXFonts);
var
  i: integer;
  H,Header: TBIFFHeader;
  RecId: word;
  P,Buf: PByteArray;
  Shape: TShapeOutsideMsoChart;
  XFont: TXFont;
begin
  while Stream.ReadHeader(Header) = SizeOf(TBIFFHeader) do begin
    case Header.RecId of
      BIFFRECID_EOF: begin
        Stream.Read(PBuf^,Header.Length);
        Add(TChartRecord.Create(Self,Header,PBuf));
        Exit;
      end;
      BIFFRECID_MSODRAWING: begin
        i := Add(TChartRecord.Create(Self,Header,Nil));
        Shape := TShapeOutsideMsoChart(Items[i].Root.Parent);
        Shape.Drawing := TEscherDrawing.Create(Shape.DrawingGroup,Nil,Nil);
        Shape.Drawing.LoadFromStream(Stream,PBuf);
      end;
      CHARTRECID_BEGIN: begin
        Items[Count - 1].Read(Stream,PBuf,Fonts);
      end;
      CHARTRECID_GELFRAME: begin
        H.Length := Header.Length;
        H.RecID := Header.RecID;
        Buf := AllocMem(H.Length);
        try
          Stream.Read(Buf^,Header.Length);
          repeat
            RecId := Stream.PeekHeader;
            if ((RecId = CHARTRECID_GELFRAME) or (RecId = BIFFRECID_CONTINUE)) then begin
              if Stream.ReadHeader(Header) <> SizeOf(TBIFFHeader) then
                Break;
              Stream.Read(PBuf^,Header.Length);

              ReAllocMem(Buf,H.Length + Header.Length);
              P := PByteArray(Integer(Buf) + H.Length);
              System.Move(PBuf^,P^,Header.Length);
              Inc(H.Length,Header.Length);
            end;
          until ((RecId <> CHARTRECID_GELFRAME) and (RecId <> BIFFRECID_CONTINUE));
          Add(TChartRecordUpdate.Create(Self,H,Buf));
        finally
          FreeMem(Buf);
        end;
      end;
      CHARTRECID_FBI: begin
        Stream.Read(PBuf^,Header.Length);
        Header.Length := SizeOf(TCRecFBI_Font);
        PCRecFBI_Font(PBuf).XFont := Fonts[PCRecFBI(PBuf).Index];
        TXFont(PCRecFBI_Font(PBuf).XFont).Unique := True;
        Add(TChartRecord.Create(Self,Header,PBuf));
      end;
      CHARTRECID_FONTX: begin
        Stream.Read(PBuf^,Header.Length);
//        Fonts[PCRecFONTX(PBuf).FontIndex].Unique := True;
        XFont := FindFBIFont(PCRecFONTX(PBuf).FontIndex);
        if XFont <> Nil then
          Add(TChartRecord.Create(Self,Header.RecId,XFont))
        else
          Add(TChartRecord.Create(Self,Header.RecId,Fonts[PCRecFONTX(PBuf).FontIndex]));
      end;
      CHARTRECID_END: begin
        Stream.Read(PBuf^,Header.Length);
        Exit;
      end;
      else begin
        Stream.Read(PBuf^,Header.Length);
        Add(TChartRecord.Create(Self,Header,PBuf));
      end;
    end;
  end;
end;

procedure TChartRecord.ReadDefault(DefRecs: array of TDefaultRecord; var Index: integer; Fonts: TXFonts);
var
  i: integer;
  Rec: TChartRecord;
  Header: TBIFFHeader;
begin
  while Index <= High(DefRecs) do begin
    Header.RecID := DefRecs[Index].Id;
    Header.Length := System.Length(DefRecs[Index].Data);
    case Header.RecId of
      BIFFRECID_EOF: begin
        Add(TChartRecord.Create(Self,Header,Nil));
        Exit;
      end;
      CHARTRECID_BEGIN: begin
        Inc(Index);
        if Count > 0 then
          Items[Count - 1].ReadDefault(DefRecs,Index,Fonts);
//        FChilds.ReadDefault(Index);
      end;
      CHARTRECID_END:
        Exit;
      CHARTRECID_FBI: begin
        Add(TChartRecord.Create(Self,Header,PByteArray(@DefRecs[Index].Data[1])));
        Rec := Items[Count - 1];
        PCRecFBI_Font(Rec.FData).XFont := Fonts.Add;
        TXFont(PCRecFBI_Font(Rec.FData).XFont).Unique := True;
      end;
      CHARTRECID_FONTX: begin
        Add(TChartRecord.Create(Self,Header.RecId,FindFBIFont(PCRecFONTX(@DefRecs[Index].Data[1]).FontIndex)));
      end;
      ID_CHARTRECORD_DEFAULTLEGEND: begin
        i := 0;
        ReadDefault(DefaultRecordsLegend,i,Fonts);
      end;
      else begin
        if Header.Length > 0 then
          Add(TChartRecord.Create(Self,Header,PByteArray(@DefRecs[Index].Data[1])))
        else
          Add(TChartRecord.Create(Self,Header,Nil));
      end;
    end;
    Inc(Index);
  end;
end;

procedure TChartRecord.Write(Stream: TXLSStream);
var
  i: integer;
  Buf: PByteArray;
  Shape: TShapeOutsideMsoChart;
begin
  for i := 0 to Count - 1 do begin
    case Items[i].FRecId of
      CHARTRECID_GELFRAME: begin
        if (Items[i] is TChartRecordUpdate) and Assigned(TChartRecordUpdate(Items[i]).OnUpdate) then
          TChartRecordUpdate(Items[i]).OnUpdate(Self);
        Stream.WriteCONTINUE(CHARTRECID_GELFRAME,Items[i].FData^,Items[i].Length);
      end;
      BIFFRECID_MSODRAWING: begin
        GetMem(Buf,MAXRECSZ_97);
        try
          Shape := TShapeOutsideMsoChart(Items[i].Root.Parent);
          Shape.Drawing.SaveToStream(Stream,Buf);
        finally
          FreeMem(Buf);
        end;
      end;
      CHARTRECID_FBI: begin
        Stream.WWord(Items[i].FRecId);
        PCRecFBI(Items[i].FData).Index := TXFont(PCRecFBI_Font(Items[i].FData).XFont).Index;
        Stream.WWord(SizeOf(TCRecFBI));
        Stream.Write(Items[i].FData^,SizeOf(TCRecFBI));
      end;
      CHARTRECID_FONTX: begin
        Stream.WWord(Items[i].FRecId);
        Stream.WWord(2);
        Stream.WWord(TXFont(Items[i].Data).Index);
      end;
      else begin
        Stream.WWord(Items[i].FRecId);
        Stream.WWord(Items[i].FLength);
        if Items[i].FLength > 0 then
          Stream.Write(Items[i].FData^,Items[i].FLength);
      end;
    end;
    if Items[i].Count > 0 then begin
      Stream.WriteHeader(CHARTRECID_BEGIN,0);
      Items[i].Write(Stream);
      Stream.WriteHeader(CHARTRECID_END,0);
    end;
  end;
end;

constructor TChartRecord.Create(Parent: TChartRecord; Header: TBIFFHeader; D: PByteArray);
begin
  inherited Create;
  GetMem(FData,Header.Length);
  if D <> Nil then
    System.Move(D^,FData^,Header.Length);
  FParent := Parent;
  FRecId := Header.RecID;
  FLength := Header.Length;
end;

constructor TChartRecord.Create(Parent: TChartRecord; RecId, Length: word);
begin
  inherited Create;
  GetMem(FData,Length);
  FParent := Parent;
  FRecId := RecID;
  FLength := Length;
end;

constructor TChartRecord.Create(Parent: TChartRecord; RecId: word; Obj: TObject);
begin
  inherited Create;
  FData := PByteArray(Obj);
  FParent := Parent;
  FRecId := RecID;
  FLength := 0;
end;

destructor TChartRecord.Destroy;
var
  Fonts: TXFonts;
begin
  if RecId = CHARTRECID_FONTX then begin
    Fonts := TShapeOutsideMsoChart(Root.Parent).Fonts;
    Fonts.Delete(TXFont(FData).Index);
  end
  else if FLength > 0 then begin
    FreeMem(FData);
    FLength := 0;
  end;
  FData := Nil;
  inherited;
end;

procedure TChartRecord.Resize(Delta: integer);
begin
  Inc(FLength,Delta);
  ReAllocMem(FData,FLength);
end;

procedure TChartRecord.ReadDefaultRecords(RecData: TDefaultRecordData);
var
  i: integer;
  Fonts: TXFonts;
begin
  Fonts := TShapeOutsideMsoChart(Root.Parent).Fonts;
  i := 0;
  case RecData of
    drdAll:            ReadDefault(DefaultRecordsAll,i,Fonts);
    drdLegend:         ReadDefault(DefaultRecordsLegend,i,Fonts);
    drdSerie: begin
      i := DefaultRecordsSerieIndex;
      ReadDefault(DefaultRecordsAll,i,Fonts);
    end;
    drdDataformat:     ReadDefault(DefaultRecordsDataformat,i,Fonts);
    drdStyleArea:      ReadDefault(DefaultRecordsStyleArea,i,Fonts);
    drdStyleBarColumn: ReadDefault(DefaultRecordsStyleBarColumn,i,Fonts);
    drdStyleLine:      ReadDefault(DefaultRecordsStyleLine,i,Fonts);
    drdStylePie:       ReadDefault(DefaultRecordsStylePie,i,Fonts);
    drdStyleRadar:     ReadDefault(DefaultRecordsStyleRadar,i,Fonts);
    drdStyleScatter:   ReadDefault(DefaultRecordsStyleScatter,i,Fonts);
    drdStyleSurface:   ReadDefault(DefaultRecordsStyleSurface,i,Fonts);
  end;
end;

function TChartRecord.RemoveRecord(Id: integer): boolean;
var
  i: integer;
begin
  i := FindRecord(Id);
  Result := i >= 0;
  if Result then
    Delete(i);
end;

function TChartRecord.Root: TChartRecord;
begin
  Result := Self;
  while (Result <> Nil) and (Result.FRecId <> ID_CHARTRECORDROOT) do
    Result := Result.FParent;
  if Result.FRecId <> ID_CHARTRECORDROOT then
    Result := Nil;
end;

end.