uchart.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

{*******************************************************}
{                                                       }
{       图形分析                                        }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

unit uChart;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, DBChart, StdCtrls,db,Series,
  Buttons,DBGridEh;

type
  TColParams = record 
    FieldName: string;
    Title: string;
  end;
  TFormChart = class(TForm)
    Panel1: TPanel;
    DBChart1: TDBChart;
    RadioGroup1: TRadioGroup;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    FFirstRun:Boolean;
    ColArray,ColArray2: array of TColParams;
    FGrid:TDBGridEh;
    FTitle:string;
    Bar:TBarSeries;              //柱形
    Pie:TPieSeries;              //饼形
    Area:TAreaSeries;            //领域图
    FastLine:TFastLineSeries;    //曲线图
    procedure CreateSeries;
    procedure CreateChart;
    procedure FillField;
    function GetLableFieldName:string;
    function GetValueFieldName:string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormChart: TFormChart;

const
  FLable='请录入标识字段';
  FValue='请录入统计字段';

//==============================================================================
// ATitle: TDBChart.title
//==============================================================================

procedure ShowChart(AGrid:TDBGridEh;ATitle:string='');

implementation

{$R *.dfm}

procedure ShowChart(AGrid:TDBGridEh;ATitle:string='');
begin
  FormChart:=TFormChart.Create(nil);
  try
    FormChart.FGrid:=AGrid;
    FormChart.FTitle:=ATitle;
    FormChart.RadioGroup1.ItemIndex:=0;
    FormChart.DBChart1.Title.Text.Clear;
    FormChart.DBChart1.Title.Text.Add(FormChart.FTitle);
    FormChart.ShowModal;
  finally
    FreeAndNil(FormChart);
  end;
end;

procedure TFormChart.BitBtn1Click(Sender: TObject);
begin
  FFirstRun:=False;
  CreateChart;
end;

procedure TFormChart.BitBtn2Click(Sender: TObject);
begin
  DBChart1.Print;
end;

procedure TFormChart.BitBtn3Click(Sender: TObject);
var
  sav:TSaveDialog;
begin
  sav:=TSaveDialog.Create(nil);
  try
    sav.Filter:='位图(BMP)|*.BMP';
    sav.FileName:='文件1';
    sav.FilterIndex:=1;
    if sav.Execute then
      DBChart1.SaveToBitmapFile(sav.FileName+'.BMP'); 
  finally
    sav.Free;
  end;
end;

procedure TFormChart.CheckBox1Click(Sender: TObject);
begin
  DBChart1.View3D:=CheckBox1.Checked;
end;

procedure TFormChart.CreateChart;
begin
  if FFirstRun then exit;

  if Trim(ComboBox1.Text)='' then
  begin
    ShowMessage(FLable);
    Exit;
  end;
  if Trim(ComboBox2.Text)='' then
  begin
    ShowMessage(FValue);
    Exit;
  end;

  DBChart1.SeriesList.Clear;

  DBChart1.View3D:=CheckBox1.Checked;
  
  case RadioGroup1.ItemIndex of
    0:
    begin
      with Bar do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FGrid.DataSource.DataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    1:
    begin
      with Pie do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FGrid.DataSource.DataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    2:
    begin
      with Area do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FGrid.DataSource.DataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    3:
    begin
      with FastLine do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FGrid.DataSource.DataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
  end;
  FFirstRun:=False;
end;

procedure TFormChart.CreateSeries;
begin
  Bar:=TBarSeries.Create(Self);
  Pie:=TPieSeries.Create(Self);
  Area:=TAreaSeries.Create(Self);
  FastLine:=TFastLineSeries.Create(Self);
end;

procedure TFormChart.FillField;
var
  i:Integer;
begin
  ComboBox1.Items.Clear;
  ComboBox2.Items.Clear;

  SetLength(ColArray,FGrid.Columns.Count);
  SetLength(ColArray2,FGrid.Columns.Count);
  
  for i:=0 to FGrid.Columns.Count-1 do
  begin
    if not (FGrid.Columns[i].Field is TNumericField)
      or (FGrid.Columns[i].Field is TIntegerField) then
    begin
      if FGrid.Columns[i].Visible then
      begin
        ColArray[i].FieldName:=FGrid.Columns[i].FieldName;
        ColArray[i].Title:=FGrid.Columns[i].Title.Caption;
        ComboBox1.Items.Add(ColArray[i].Title);
        if ComboBox1.Items.Count>0 then
          ComboBox1.ItemIndex:=0;
      end;
    end else
    begin
      if FGrid.Columns[i].Visible then
      begin
        ColArray2[i].FieldName:=FGrid.Columns[i].FieldName;
        ColArray2[i].Title:=FGrid.Columns[i].Title.Caption;
        ComboBox2.Items.Add(ColArray2[i].Title);
        if ComboBox2.Items.Count>0 then
          ComboBox2.ItemIndex:=0;
      end;
    end;  
  end;
end;

procedure TFormChart.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(Bar);
  FreeAndNil(Pie);
  FreeAndNil(Area);
  FreeAndNil(FastLine);
  Action:=caFree;
  FormChart:=nil;
end;

procedure TFormChart.FormCreate(Sender: TObject);
begin
  FFirstRun:=True;
  CreateSeries;
end;

procedure TFormChart.FormShow(Sender: TObject);
begin
  CheckBox1.Checked:=True;
  FillField;
end;

function TFormChart.GetLableFieldName: string;
var
  i:Integer;
begin
  for i := Low(ColArray) to High(ColArray) do
  begin
    if ColArray[i].Title=ComboBox1.Text then
      Result:=ColArray[i].FieldName;
  end;    
end;

function TFormChart.GetValueFieldName: string;
var
  i:Integer;
begin
  for i := Low(ColArray2) to High(ColArray2) do
  begin
    if ColArray2[i].Title=ComboBox2.Text then
      Result:=ColArray2[i].FieldName;
  end;    
end;

procedure TFormChart.RadioGroup1Click(Sender: TObject);
begin
  CreateChart;
end;

end.