drawingobjchart2.pas

一个经典的读写Excel的控件

  Result.FFormulaHandler := FFormulaHandler;
end;

constructor TChartSeries.Create(AOwner: TPersistent; FormulaHandler: TFormulaHandler);
begin
  inherited Create(TChartSerie);
  FOwner := AOwner;
  FFormulaHandler := FormulaHandler;
end;

procedure TChartSeries.Delete(Index: integer);
var
  i: integer;
begin
  i := Items[Index].FRecord.Parent.IndexOf(Items[Index].FRecord);
  if i >= 0 then
    Items[Index].FRecord.Parent.Delete(i);
  Items[Index].FRecord.Free;
  inherited Delete(Index);
end;

function TChartSeries.GetChartSerie(Index: integer): TChartSerie;
begin
  Result := TChartSerie(inherited Items[Index]);
end;

function TChartSeries.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{ TChartSerie }

procedure TChartSerie.AssignRecords(Rec: TChartRecord);
var
  i: integer;
begin
  FRecord := Rec;
  FiRecAI_Values := -1;
  FiRecAI_Values2 := -1;
  FiRecAI_Category := -1;
  FiRecAI_SerieName := -1;
  PRecGeomtery := Nil;
  i := 0;
  while i < FRecord.Count do begin
    case FRecord[i].RecId of
      CHARTRECID_AI: begin
        case PCRecAI(FRecord[i].Data).LinkType of
          0: FiRecAI_SerieName := i;
          1: FiRecAI_Values := i;
          2: FiRecAI_Category := i;
          3: FiRecAI_Values2 := i;
        end;
      end;
      CHARTRECID_DATAFORMAT: begin
        if PCRecDATAFORMAT(FRecord[i].Data).PointNumber = $FFFF then begin
          FDefDatapoint.AssignRecords(FRecord[i]);
          if (FRecord[i].Count > 0) and (FRecord[i][0].RecId = CHARTRECID_GEOMETRY) then
            PRecGeomtery := FRecord[i][0];
        end
        else
          FDatapoints.AddFromFile.AssignRecords(FRecord[i]);
      end;
    end;
    Inc(i);
  end;
end;

constructor TChartSerie.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FDataPoints := TDataPoints.Create(Self);
  FDefDatapoint := TDataPoint.Create;
end;

destructor TChartSerie.Destroy;
begin
  FDataPoints.Free;
  FDefDatapoint.Free;
  inherited;
end;

function TChartSerie.GetAIFormula(AI: PCRecAI): WideString;
begin
  if AI.FormulaSize > 0 then
    Result := FFormulaHandler.DecodeFormula(@AI.Formula,AI.FormulaSize)
  else
    Result := '';
end;

function TChartSerie.GetCategory: WideString;
begin
  if FiRecAI_Category < 0 then
    raise Exception.Create('Property has no data');
  Result := GetAIFormula(PCRecAI(FRecord[FiRecAI_Category].Data));
end;
{
function TChartSerie.GetCategoriesCount: integer;
begin
  Result := PCRecSERIES(FRecord.Data).CategoriesCount;
end;
}
function TChartSerie.GetGeomtery: TSerieItemGeomtery;
var
  i: integer;
begin
  Result := sigDefault;
  if PRecGeomtery = Nil then
    Exit;
  for i := 0 to Ord(sigLast) - 1 do begin
    if PCRecGEOMETRY(PRecGeomtery.Data).ItemType = Word(TSerieItemGeomtery(i)) then begin
      Result := TSerieItemGeomtery(i);
      Exit;
    end;
  end;
end;

function TChartSerie.GetHasDefDataPoint: boolean;
begin
  Result := FDefDataPoint.FRecord.Count >= 3;
end;

function TChartSerie.GetSerieName: WideString;
var
  i: integer;
begin
  if FiRecAI_SerieName < 0 then
    raise Exception.Create('Property has no data');
  i := FiRecAI_SerieName;
  if PCRecAI(FRecord[i].Data).ReferenceType = 1 then begin
    Inc(i);
    if (i < FRecord.Count) and (FRecord[i].RecId = CHARTRECID_SERIESTEXT) then begin
      Result := ByteStrToWideString(@PCRecSERIESTEXT(FRecord[i].Data).Text,PCRecSERIESTEXT(FRecord[i].Data).Length);
      if Result <> '' then
        Result := '"' + Result + '"';
    end
    else
      Result := '';
  end
  else
    Result := GetAIFormula(PCRecAI(FRecord[i].Data));
end;

function TChartSerie.GetValues: WideString;
begin
  if FiRecAI_Values < 0 then
    raise Exception.Create('Property has no data');
  Result := GetAIFormula(PCRecAI(FRecord[FiRecAI_Values].Data));
end;

function TChartSerie.GetValues2: WideString;
begin
  if FiRecAI_Values2 < 0 then
    raise Exception.Create('Property has no data');
  Result := GetAIFormula(PCRecAI(FRecord[FiRecAI_Values2].Data));
end;

procedure TChartSerie.SetAIFormula(AI: TChartRecord; Value: WideString);
var
  Sz,Delta: integer;
  P: PByteArray;
begin
  GetMem(P,MAXRECSZ_97);
  try
    Sz := FFormulaHandler.EncodeFormula(Value,P,MAXRECSZ_97);
    Delta := Sz - (AI.Length - SizeOf(TCRecAI));
    AI.Resize(Delta);
    Move(P^,PCRecAI(AI.Data).Formula,Sz);
    PCRecAI(AI.Data).FormulaSize := Sz;
    if Sz = 0 then
      PCRecAI(AI.Data).ReferenceType := 1
    else
      PCRecAI(AI.Data).ReferenceType := 2;
  finally
    FreeMem(P);
  end;
end;

procedure TChartSerie.SetCategory(const Value: WideString);
begin
  if FiRecAI_Category < 0 then
    raise Exception.Create('Property has no data');
  SetAIFormula(FRecord[FiRecAI_Category],Value);
end;

procedure TChartSerie.SetGeomtery(const Value: TSerieItemGeomtery);
begin
  if PRecGeomtery = Nil then
    Exit;
  case Value of
    sigDefault        : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0000;
    sigCylinder       : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0001;
    sigPyramid        : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0100;
    sigChoppedPyramid : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0200;
    sigCone           : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0101;
    sigChoppedCone    : PCRecGEOMETRY(PRecGeomtery.Data).ItemType := $0201;
  end;
end;

procedure TChartSerie.SetHasDefDataPoint(const Value: boolean);
begin
  if Value = GetHasDefDataPoint then
    Exit;
  FDefDatapoint.FRecord.ReadDefaultRecords(drdDataformat);
  FDefDatapoint.AssignRecords(FDefDatapoint.FRecord);
end;

procedure TChartSerie.SetSerieName(const Value: WideString);
var
  i: integer;
  S: WideString;
  L,Delta: integer;
  Rec: TChartRecord;
begin
  if FiRecAI_SerieName < 0 then
    raise Exception.Create('Property has no data');
  if (Value <> '') and (Value[1] = '"') then begin
    S := Copy(Value,2,MAXINT);
    if Copy(S,Length(S),1) = '"' then
      S := Copy(S,1,Length(S) - 1);
    i := FiRecAI_SerieName + 1;
    if i < FRecord.Count then begin
      if FRecord[i].RecId <> CHARTRECID_SERIESTEXT then begin
        Rec := FRecord.InsertRecord(i,CHARTRECID_SERIESTEXT,SizeOf(TCRecSERIESTEXT));
        PCRecSERIESTEXT(Rec.Data).TextId := 0;
      end
      else
        Rec := FRecord[i];
      L := Length(S) * 2 + 1;
      Delta := L - (Rec.Length - SizeOf(TCRecSERIESTEXT));
      Rec.Resize(Delta);
      WideStringToByteStr(S,@PCRecSERIESTEXT(Rec.Data).Text);
      PCRecSERIESTEXT(Rec.Data).Length := Length(S);
      PCRecAI(FRecord[FiRecAI_SerieName].Data).ReferenceType := 1;
    end;
  end
  else
    SetAIFormula(FRecord[FiRecAI_SerieName],Value);
end;

procedure TChartSerie.SetValues(const Value: WideString);
begin
  if FiRecAI_Values < 0 then
    raise Exception.Create('Property has no data');
  SetAIFormula(FRecord[FiRecAI_Values],Value);
end;

procedure TChartSerie.SetValues2(const Value: WideString);
begin
  if FiRecAI_Values2 < 0 then
    raise Exception.Create('Property has no data');
  SetAIFormula(FRecord[FiRecAI_Values2],Value);
end;

{ TDataPoint }

procedure TDataPoint.AssignRecords(Rec: TChartRecord);
var
  i: integer;
begin
  if Rec.Count = 0 then
    raise Exception.Create('DATAFORMAT has no child records');
  FRecord := Rec;
  for i := 0 to FRecord.Count - 1 do begin
    case FRecord[i].RecId of
      CHARTRECID_LINEFORMAT:     FLineFormat.Assign(FRecord[i]);
      CHARTRECID_AREAFORMAT:     FAreaFormat.Assign(FRecord[i]);
      CHARTRECID_PIEFORMAT:      FRecPIEFORMAT := FRecord[i];
      CHARTRECID_MARKERFORMAT:   FMarkerFormat.Assign(FRecord[i]);
      CHARTRECID_ATTACHEDLABEL:  FRecATTACHEDLABEL := FRecord[i];
    end;
  end;
end;

constructor TDataPoint.Create;
begin
  FLineFormat := TLineFormat.Create;
  FAreaFormat := TAreaFormat.Create;
  FMarkerFormat := TMarkerFormat.Create;
end;

destructor TDataPoint.Destroy;
begin
  FLineFormat.Free;
  FAreaFormat.Free;
  FMarkerFormat.Free;
  inherited;
end;

function TDataPoint.GetDataLablel: TChartDataLabels;
begin
  Result := TChartDataLabels(Byte(PCRecATTACHEDLABEL(FRecATTACHEDLABEL.Data).Flags));
end;

function TDataPoint.GetPieSliceDist: integer;
begin
  if FRecPIEFORMAT = Nil then
    raise Exception.Create('Property has no data.');
  Result := PCRecPIEFORMAT(FRecPIEFORMAT.Data).Percent;
end;

function TDataPoint.GetPointIndex: integer;
begin
  Result := PCRecDATAFORMAT(FRecord.Data).PointNumber;
end;

procedure TDataPoint.SetDataLablel(const Value: TChartDataLabels);
begin
  PCRecATTACHEDLABEL(FRecATTACHEDLABEL.Data).Flags := Byte(Value);
end;

procedure TDataPoint.SetPieSliceDist(const Value: integer);
begin
  if FRecPIEFORMAT = Nil then
    raise Exception.Create('Property has no data.');
  if (Value < 0) or (Value > 100) then
    raise Exception.Create('Value out of range');
  PCRecPIEFORMAT(FRecPIEFORMAT.Data).Percent := Value;
end;

procedure TDataPoint.SetPointIndex(const Value: integer);
begin
  if Value < 0 then
    raise Exception.Create('Point index out of range.');
  PCRecDATAFORMAT(FRecord.Data).PointNumber := Value;
end;

{ TDataPoints }

function TDataPoints.Add: TDataPoint;
var
  i: integer;
begin
  Result := TDataPoint.Create;
  i := TChartSerie(FOwner).FRecord.FindRecord(CHARTRECID_DATAFORMAT);
  if i < 0 then
    raise Exception.Create('Can not find insertion point.');
  Result.FRecord := TChartSerie(FOwner).FRecord.InsertRecord(i + 1,CHARTRECID_DATAFORMAT,SizeOf(TCRecDATAFORMAT));
  PCRecDATAFORMAT(Result.FRecord.Data).PointNumber := 0;
  PCRecDATAFORMAT(Result.FRecord.Data).SeriesIndex := TChartSerie(FOwner).Index;
  PCRecDATAFORMAT(Result.FRecord.Data).SeriesNumber := TChartSerie(FOwner).Index;
  PCRecDATAFORMAT(Result.FRecord.Data).Flags := 0;
  Result.FRecord.ReadDefaultRecords(drdDataformat);
  Result.AssignRecords(Result.FRecord);
end;

function TDataPoints.AddFromFile: TDataPoint;
begin
  Result := TDataPoint.Create;
end;

constructor TDataPoints.Create(AOwner: TObject);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TDataPoints.Delete(Index: integer);
var
  i: integer;
  Rec: TChartRecord;
begin
  Rec := TChartSerie(FOwner).FRecord;
  for i := 0 to Rec.Count - 1 do begin
    if Rec[i] = Items[Index].FRecord then begin
      Rec.Delete(i);
      Break;
    end;
  end;
  inherited Delete(Index);
end;

function TDataPoints.GetItems(Index: integer): TDataPoint;
begin
  Result := TDataPoint(inherited Items[Index]);
end;

{ TLineFormat }

function TLineFormat.GetAutomatic: boolean;
begin
  Check;
  Result := (PCRecLINEFORMAT(FRecord.Data).Format and $0001) = $0001;
end;

function TLineFormat.GetLineColor: TExcelColor;
begin
  Check;