frxchart.pas

这个是功能强大的报表软件

  frxSetCommaText(v1, sl1);
  frxSetCommaText(v2, sl2);
  frxSetCommaText(v3, sl3);
  frxSetCommaText(v4, sl4);
  frxSetCommaText(v5, sl5);
  frxSetCommaText(v6, sl6);

  Helper := frxFindSeriesHelper(Series);

  try
    if sl2.Count > 0 then
    begin
      if (FTopN > 0) and (FTopN < sl2.Count) then
        MakeTopN
      else if FSortOrder <> soNone then
        Sort;

      for i := 0 to sl2.Count - 1 do
      begin
        if i < sl1.Count then v1 := sl1[i] else v1 := '';
        if i < sl2.Count then v2 := sl2[i] else v2 := '';
        if i < sl3.Count then v3 := sl3[i] else v3 := '';
        if i < sl4.Count then v4 := sl4[i] else v4 := '';
        if i < sl5.Count then v5 := sl5[i] else v5 := '';
        if i < sl6.Count then v6 := sl6[i] else v6 := '';
        Helper.AddValues(Series, v1, v2, v3, v4, v5, v6, FXType);
      end;
    end;

  finally
    Helper.Free;
    sl1.Free;
    sl2.Free;
    sl3.Free;
    sl4.Free;
    sl5.Free;
    sl6.Free;
  end;
end;

{$IFDEF FR_COM}
function TfrxSeriesItem.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TfrxSeriesItem._AddRef: Integer; stdcall;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TfrxSeriesItem._Release: Integer; stdcall;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then Destroy;
end;

function TfrxSeriesItem.Get_DataBand(out Value: IfrxDataBand): HResult; stdcall;
begin
  Value := DataBand;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_DataBand(const Value: IfrxDataBand): HResult; stdcall;
var
  idsp:   {IfrxComponentSelf}IInterfaceComponentReference;
begin
  Result := Value.QueryInterface({IfrxComponentSelf}IInterfaceComponentReference, idsp);
  if Result = S_OK then
  begin
    DataBand := TfrxDataBand(idsp.{Get_Object} GetComponent);
    idsp._Release;
  end;
end;

function TfrxSeriesItem.Get_DataSet(out Value: IfrxDataSet): HResult; stdcall;
begin
  Value := DataSet;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_DataSet(const Value: IfrxDataSet): HResult; stdcall;
var
  idsp:   {IfrxComponentSelf} IInterfaceComponentReference;
begin
  Result := Value.QueryInterface({IfrxComponentSelf}IInterfaceComponentReference, idsp);
  if Result = S_OK  then
  begin
    DataSet := TfrxDataSet(idsp.GetComponent{Get_Object});
  end;
end;

function TfrxSeriesItem.Get_DataSetName(out Value: WideString): HResult; stdcall;
begin
  Value := DataSetName;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_DataSetName(const Value: WideString): HResult; stdcall;
begin
  DataSetName := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_XSource(out Value: WideString): HResult; stdcall;
begin
  Value := XSource;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_XSource(const Value: WideString): HResult; stdcall;
begin
  XSource := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_YSource(out Value: WideString): HResult; stdcall;
begin
  Value := YSource;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_YSource(const Value: WideString): HResult; stdcall;
begin
  YSource := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_XValues(out Value: WideString): HResult; stdcall;
begin
  Value := XValues;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_XValues(const Value: WideString): HResult; stdcall;
begin
  XValues := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_YValues(out Value: WideString): HResult; stdcall;
begin
  Value := YValues;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_YValues(const Value: WideString): HResult; stdcall;
begin
  YValues := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_TopNCaption(out Value: WideString): HResult; stdcall;
begin
  Value := TopNCaption;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_TopNCaption(const Value: WideString): HResult; stdcall;
begin
  TopNCaption := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_Title(out Value: WideString): HResult; stdcall;
begin
  Value := Series.Title;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_Title(const Value: WideString): HResult; stdcall;
begin
  Series.Title := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_ZSource(out Value: WideString): HResult; stdcall;
begin
  Value := Source3;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_ZSource(const Value: WideString): HResult; stdcall;
begin
  Source3 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_ZValues(out Value: WideString): HResult; stdcall;
begin
  Value := Values3;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_ZValues(const Value: WideString): HResult; stdcall;
begin
  Values3 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_FourthSource(out Value: WideString): HResult; stdcall;
begin
  Value := Source4;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_FourthSource(const Value: WideString): HResult; stdcall;
begin
  Source4 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_FourthValues(out Value: WideString): HResult; stdcall;
begin
  Value := Values4;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_FourthValues(const Value: WideString): HResult; stdcall;
begin
  Values4 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_FifthSource(out Value: WideString): HResult; stdcall;
begin
  Value := Source5;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_FifthSource(const Value: WideString): HResult; stdcall;
begin
  Source5 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_FifthValues(out Value: WideString): HResult; stdcall;
begin
  Value := Values5;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_FifthValues(const Value: WideString): HResult; stdcall;
begin
  Values5 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_SixthSource(out Value: WideString): HResult; stdcall;
begin
  Value := Source6;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_SixthSource(const Value: WideString): HResult; stdcall;
begin
  Source6 := Value;
  Result := S_OK;
end;

function TfrxSeriesItem.Get_SixthValues(out Value: WideString): HResult; stdcall;
begin
  Value := Values6;
  Result := S_OK;
end;

function TfrxSeriesItem.Set_SixthValues(const Value: WideString): HResult; stdcall;
begin
  Values6 := Value;
  Result := S_OK;
end;
function TfrxSeriesItem.Get_XAxisType(out Value: frxSeriesXType): HResult; stdcall;
begin
  Value := frxSeriesXType(XType);
  Result := S_OK;
end;

function TfrxSeriesItem.Set_XAxisType(Value: frxSeriesXType): HResult; stdcall;
begin
  XType := TfrxSeriesXType(Value);
  Result := S_OK;
end;
{$ENDIF}

{ TfrxSeriesData }

constructor TfrxSeriesData.Create(Report: TfrxReport);
begin
  inherited Create(TfrxSeriesItem);
  FReport := Report;
end;

function TfrxSeriesData.Add: TfrxSeriesItem;
begin
  Result := TfrxSeriesItem(inherited Add);
end;

function TfrxSeriesData.GetSeries(Index: Integer): TfrxSeriesItem;
begin
  Result := TfrxSeriesItem(inherited Items[Index]);
end;


{ TfrxChartView }

constructor TfrxChartView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CreateChart;
  FSeriesData := TfrxSeriesData.Create(Report);
{$IFDEF FR_COM}
  FLeftAxis := TfrxChartAxis.Create(Chart.LeftAxis);
  FBottomAxis := TfrxChartAxis.Create(Chart.BottomAxis);
{$ENDIF}
end;

destructor TfrxChartView.Destroy;
begin
{$IFDEF FR_COM}
  FLeftAxis.Destroy;
  FBottomAxis.Destroy;
{$ENDIF}
  FChart.Free;
  inherited Destroy;
  FSeriesData.Free;
end;

class function TfrxChartView.GetDescription: String;
begin
  Result := frxResources.Get('obChart');
end;

procedure TfrxChartView.Notification(AComponent: TComponent; Operation: TOperation);
var
  i: Integer;
begin
  inherited;
  if Operation = opRemove then
  begin
    for i := 0 to FSeriesData.Count - 1 do
      if AComponent is TfrxDataSet then
      begin
        if FSeriesData[i].DataSet = AComponent then
          FSeriesData[i].DataSet := nil;
      end
      else if AComponent is TfrxBand then
      begin
        if FSeriesData[i].DataBand = AComponent then
          FSeriesData[i].DataBand := nil;
      end;
  end;
end;

class function TfrxChartView.GetChartClass: TChartClass;
begin
  Result := TChart;
end;

procedure TfrxChartView.CreateChart;
begin
  FChart := GetChartClass.Create(Self);
  with FChart do
  begin
    Color := clWhite;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    Name := 'Chart';
    Frame.Visible := False;
    View3DOptions.Rotation := 0;
    Title.Text.Text := '';
  end;
end;

procedure TfrxChartView.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('Chart', ReadData, WriteData, True);
  Filer.DefineProperty('ChartElevation', ReadData1, WriteData1, True);
  Filer.DefineProperty('SeriesData', ReadData2, WriteData2, True);
end;

procedure TfrxChartView.ReadData(Stream: TStream);
begin
  FChart.Free;
  CreateChart;
  Stream.ReadComponent(FChart);
end;

procedure TfrxChartView.WriteData(Stream: TStream);
begin
  Stream.WriteComponent(FChart);
end;

procedure TfrxChartView.ReadData1(Reader: TReader);
begin
  FChart.View3DOptions.Elevation := Reader.ReadInteger;
end;

procedure TfrxChartView.WriteData1(Writer: TWriter);
begin
  Writer.WriteInteger(FChart.View3DOptions.Elevation);
end;

procedure TfrxChartView.ReadData2(Reader: TReader);
begin
  frxReadCollection(FSeriesData, Reader, Self);
end;

procedure TfrxChartView.WriteData2(Writer: TWriter);
begin
  frxWriteCollection(FSeriesData, Writer, Self);
end;

procedure TfrxChartView.FillChart;
var
  i: Integer;
begin
  for i := 0 to FSeriesData.Count - 1 do
    FSeriesData[i].FillSeries(FChart.Series[i]);
end;