rm_dbchart.pas

中小企业管理系统------ ERP系统原代码

{*****************************************}
{                                         }
{         Report Machine v2.0             }
{         DBChart Add-In Object           }
{                                         }
{*****************************************}

unit RM_DBChart;

interface

{$I RM.inc}

{$IFDEF TeeChart}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, TeeProcs, TeEngine, Chart, Series, DBChart, StdCtrls, ComCtrls, Menus,
  Buttons, RM_Class, RM_DsgCtrls
{$IFDEF Delphi6}
  , Variants
{$ENDIF};

const
  rmptMetafile = 0;
  rmptBitmap = 1;

type
  TRMDBChartObject = class(TComponent) // fake component
  end;

  TRMDBChartOptions = packed record
    ChartType: Byte;
    ShowMarks, Colored: Boolean;
    MarksStyle: Byte;
    Reserved: array[0..35] of Byte;
  end;

  TRMDBChartSeries = class
  private
    FXField, FYField: string;
    FTitle: string;
    FColor: TColor;
    FDataSet: string;
  protected
  public
    ChartOptions: TRMDBChartOptions;
    constructor Create;
    property XField: string read FXField write FXField;
    property YField: string read FYField write FYField;
    property Title: string read FTitle write FTitle;
    property Color: TColor read FColor write FColor;
    property DataSet: string read FDataSet write FDataSet;
  end;

  {TRMDBChartView}
  TRMDBChartView = class(TRMView)
  private
    FPrintType: Byte;
    FDBChart: TDBChart;
    FList: TList;
    function ShowChart: Boolean;
    procedure ChartEditor(Sender: TObject);
    function GetSeries(Index: Integer): TRMDBChartSeries;
  protected
    function GetViewCommon: string; override;
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    ChartDim3D, ChartShowLegend, ChartShowAxis: Boolean;
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear;
    function SeriesCount: Integer;
    function AddSeries: TRMDBChartSeries;
    procedure DeleteSeries(Index: Integer);

    procedure Draw(aCanvas: TCanvas); override;
    procedure StreamOut(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
    property Series[Index: Integer]: TRMDBChartSeries read GetSeries;
    property PrintType: Byte read FPrintType write FPrintType;
  end;

  { TRMChartForm }
  TRMDBChartForm = class(TForm)
    Page1: TPageControl;
    Tab1: TTabSheet;
    GroupBox1: TGroupBox;
    Tab2: TTabSheet;
    btnOk: TButton;
    btnCancel: TButton;
    GroupBox3: TGroupBox;
    chkSeriesMultiColor: TCheckBox;
    chkSeriesShowMarks: TCheckBox;
    Tab3: TTabSheet;
    GroupBox4: TGroupBox;
    RB1: TRadioButton;
    RB2: TRadioButton;
    RB3: TRadioButton;
    RB4: TRadioButton;
    RB5: TRadioButton;
    SB1: TSpeedButton;
    SB4: TSpeedButton;
    SB2: TSpeedButton;
    SB6: TSpeedButton;
    SB5: TSpeedButton;
    SB3: TSpeedButton;
    TabSheet1: TTabSheet;
    ListBox1: TListBox;
    GroupBox6: TGroupBox;
    chkChartShowLegend: TCheckBox;
    chkChartShowAxis: TCheckBox;
    PopupMenu1: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    chkChartDim3D: TCheckBox;
    EditTitle1: TMenuItem;
    N1: TMenuItem;
    MoveUp1: TMenuItem;
    MoveDown1: TMenuItem;
    SB7: TSpeedButton;
    SB8: TSpeedButton;
    SB9: TSpeedButton;
    SB11: TSpeedButton;
    SB10: TSpeedButton;
    GroupBox5: TGroupBox;
    Label2: TLabel;
    Label1: TLabel;
    Label6: TLabel;
    cmbDataSet: TComboBox;
    cmbXField: TComboBox;
    cmbYField: TComboBox;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Add1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure MoveUp1Click(Sender: TObject);
    procedure MoveDown1Click(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure EditTitle1Click(Sender: TObject);
    procedure chkSeriesMultiColorClick(Sender: TObject);
    procedure cmbDataSetChange(Sender: TObject);
    procedure cmbDataSetDrawItem(Control: TWinControl; Index: Integer;
      aRect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
    FDBChartView: TRMDBChartView;
    FSeries: TRMDBChartSeries;
    FBtnColor: TRMColorPickerButton;

    procedure Localize;
    procedure LoadSeriesOptions;
    procedure SaveSeriesOptions;
    procedure FillDatasets;
  public
    { Public declarations }
  end;
{$ENDIF}

implementation

{$IFDEF TeeChart}
uses RM_Intrp, RM_Utils, RM_Const, RM_Const1, RM_CmpReg, TeeShape, ArrowCha,
  GanttCh, BubbleCh;

{$R *.DFM}

type
  THackView = class(TRMView)
  end;

  TSeriesClass = class of TChartSeries;

const
  ChartTypes: array[0..10] of TSeriesClass =
  (TLineSeries, TAreaSeries, TPointSeries, TBarSeries, THorizBarSeries, TPieSeries,
    TChartShape, TFastLineSeries, TArrowSeries, TGanttSeries, TBubbleSeries);

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

constructor TRMDBChartSeries.Create;
begin
  inherited Create;
  with ChartOptions do
  begin
    Colored := True;
  end;
  FYField := '';
  FXField := '';
  FTitle := '';
  FColor := clTeeColor;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDBChartView }

constructor TRMDBChartView.Create;
begin
  inherited Create;
  FDBChart := TDBChart.Create(RMDialogForm);
  with FDBChart do
  begin
    Parent := RMDialogForm;
    Visible := False;
    BevelInner := bvNone;
    BevelOuter := bvNone;
  end;

  ChartDim3D := True;
  ChartShowLegend := True;
  FPrintType := 0;

  BaseName := 'DBChart';
  FList := TList.Create;
end;

destructor TRMDBChartView.Destroy;
begin
  if RMDialogForm <> nil then
    FDBChart.Free;
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TRMDBChartView.Clear;
begin
  while FList.Count > 0 do
  begin
    TRMDBChartSeries(FList[0]).Free;
    FList.Delete(0);
  end;
end;

function TRMDBChartView.SeriesCount: Integer;
begin
  Result := FList.Count;
end;

function TRMDBChartView.AddSeries: TRMDBChartSeries;
var
  liSeries: TRMDBChartSeries;

  procedure _SetSeriesTitle;
  var
    i, j: Integer;
    str: string;
    liFlag: Boolean;
  begin
    for i := 1 to 9999 do
    begin
      str := 'Series' + IntToStr(i);
      liFlag := True;
      for j := 0 to FList.Count - 1 do
      begin
        if AnsiCompareText(Series[j].Title, str) = 0 then
        begin
          liFlag := False;
          Break;
        end;
      end;
      if liFlag then
      begin
        liSeries.Title := str;
        Break;
      end;
    end;
  end;

begin
  liSeries := TRMDBChartSeries.Create;
  _SetSeriesTitle;
  FList.Add(liSeries);
  Result := liSeries;
end;

procedure TRMDBChartView.DeleteSeries(Index: Integer);
begin
  if Index < FList.Count then
  begin
    TRMDBChartSeries(FList[Index]).Free;
    FList.Delete(Index);
  end;
end;

function TRMDBChartView.GetSeries(Index: Integer): TRMDBChartSeries;
begin
  Result := nil;
  if Index < FList.Count then
    Result := TRMDBChartSeries(FList[Index]);
end;

procedure TRMDBChartView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('DBChart', [RMdtHasEditor, RMdtOneObject], ChartEditor);
  AddEnumProperty('PrintType', 'ptMetafile;ptBitmap', [0, 1], nil);

  AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
  AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;

procedure TRMDBChartView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'PRINTTYPE' then
    FPrintType := Value;
end;

function TRMDBChartView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then
    Exit;
  if Index = 'PRINTTYPE' then
    Result := FPrintType;
end;

function TRMDBChartView.ShowChart: Boolean;
var
  i: Integer;
  lMetafile: TMetafile;
  lBitmap: TBitmap;
  liSeries: TRMDBChartSeries;
  liFlag: Boolean;

  procedure PaintChart;
  begin
    if FillColor = clNone then
      FDBChart.Color := clWhite
    else
      FDBChart.Color := FillColor;

    case FPrintType of
      0:
        begin
          lMetafile := FDBChart.TeeCreateMetafile(True {False}, Rect(0, 0, SaveDX, SaveDY));
          try
            Canvas.StretchDraw(DRect, lMetafile);
          finally
            lMetafile.Free;
          end;
        end;
      1:
        begin
          lBitmap := TBitmap.Create;
          try
            lBitmap.Width := SaveDX;
            lBitmap.Height := SaveDY;
            FDBChart.Draw(lBitmap.Canvas, Rect(0, 0, SaveDX, SaveDY));
            RMPrintGraphic(Canvas, DRect, lBitmap, IsPrinting);
          finally
            lBitmap.Free;
          end;
        end;
    end;
  end;

  procedure _AddSeries;
  var
    Ser: TChartSeries;
  begin
    FDBChart.View3DWalls := liSeries.ChartOptions.ChartType <> 5;
{$IFDEF Delphi4}
    FDBChart.View3DOptions.Orthogonal := liSeries.ChartOptions.ChartType <> 5;
{$ENDIF}

    Ser := ChartTypes[liSeries.ChartOptions.ChartType].Create(FDBChart);
    Ser.Title := liSeries.Title;
    Ser.ColorEachPoint := liSeries.ChartOptions.Colored;
    Ser.Marks.Visible := liSeries.ChartOptions.ShowMarks;
    Ser.Marks.Style := TSeriesMarksStyle(liSeries.ChartOptions.MarksStyle);
{$IFNDEF Delphi2}
    Ser.Marks.Font.Charset := rmCharset;
{$ENDIF}
    FDBChart.AddSeries(Ser);
    Ser.DataSource := RMGetDataSet(CurReport.Dictionary.RealDataSetName[liSeries.DataSet]);
    Ser.XValues.ValueSource := liSeries.XField;
    Ser.YValues.ValueSource := liSeries.YField;
  end;

begin
  liFlag := True;
  for i := 0 to FList.Count - 1 do
  begin
    liSeries := Series[i];
    if (liSeries.DataSet <> '') or (liSeries.XField <> '') or (liSeries.YField <> '') then
    begin
      liFlag := False;
      Break;
    end;
  end;

  Result := False;
  if liFlag or (FList.Count < 1) then Exit;

  FDBChart.RemoveAllSeries;
  FDBChart.Frame.Visible := False;
  FDBChart.LeftWall.Brush.Style := bsClear;
  FDBChart.BottomWall.Brush.Style := bsClear;

  FDBChart.View3D := ChartDim3D;
  FDBChart.Legend.Visible := ChartShowLegend;
{$IFNDEF Delphi2}
  FDBChart.Legend.Font.Charset := rmCharset;
  FDBChart.RightAxis.LabelsFont.Charset := rmCharset;
  FDBChart.LeftAxis.LabelsFont.Charset := rmCharset;
  FDBChart.TopAxis.LabelsFont.Charset := rmCharset;
  FDBChart.BottomAxis.LabelsFont.Charset := rmCharset;
{$ENDIF}
  FDBChart.AxisVisible := ChartShowAxis;
{$IFDEF Delphi4}
  FDBChart.BackWall.Brush.Style := bsClear;
  FDBChart.View3DOptions.Elevation := 315;
  FDBChart.View3DOptions.Rotation := 360;
{$ENDIF}

  for i := 0 to FList.Count - 1 do
  begin
    liSeries := Series[i];
    _AddSeries;
  end;

  PaintChart;