rm_dbchart.pas

胜天进销存源码,国产优秀的进销存

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

unit RM_DBChart;

interface

{$I RM.inc}

{$IFDEF TeeChart}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Menus, Buttons, RM_Common, RM_Class, RM_Ctrls,
  TeeProcs, TeEngine, Chart, Series, DBChart, DB, RM_DataSet
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF Delphi4}, ImgList{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

type

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

  TRMChartSeries = class
  private
    FLegendView, FValueView, FLabelView: string;
    FTitle: string;
    FColor: TColor;
    FChartType: Byte;
    FShowMarks, FColored: Boolean;
    FMarksStyle: Byte;
    FDataSet: string;
  protected
  public
    constructor Create;
  published
    property DataSet: string read FDataSet write FDataSet;
    property LegendView: string read FLegendView write FLegendView;
    property ValueView: string read FValueView write FValueView;
    property LabelView: string read FLabelView write FLabelView;
    property Title: string read FTitle write FTitle;
    property Color: TColor read FColor write FColor;
    property ChartType: Byte read FChartType write FChartType;
    property ShowMarks: Boolean read FShowMarks write FShowMarks;
    property Colored: Boolean read FColored write FColored;
    property MarksStyle: Byte read FMarksStyle write FMarksStyle;
  end;

  {TDBRMChartView}
  TDBRMChartView = class(TRMReportView)
  private
    FPrintType: TRMPrintMethodType;
    FDBChart: TDBChart;
    FPicture: TMetafile;
    FList: TList;
    FChartDim3D, FChartShowLegend, FChartShowAxis: Boolean;

    function GetUseChartSetting: Boolean;
    procedure SetUseChartSetting(Value: Boolean);
    procedure ShowChart;
    function GetSeries(Index: Integer): TRMChartSeries;
    function GetDirectDraw: Boolean;
    procedure SetDirectDraw(Value: Boolean);
  protected
    procedure Prepare; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
    function GetViewCommon: string; override;
    procedure ClearContents; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear;
    function SeriesCount: Integer;
    function AddSeries: TRMChartSeries;
    procedure DeleteSeries(Index: Integer);

    procedure Draw(aCanvas: TCanvas); override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure DefinePopupMenu(Popup: TRMCustomMenuItem); override;
//    procedure OnHook(aView: TRmView); override;
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    procedure ShowEditor; override;
    procedure AssignChart(AChart: TCustomChart);
    property Series[Index: Integer]: TRMChartSeries read GetSeries;
    property DBChart: TDBChart read FDBChart;
  published
    property PrintType: TRMPrintMethodType read FPrintType write FPrintType;
    property UseChartSetting: Boolean read GetUseChartSetting write SetUseChartSetting;
    property Memo;
    property ChartDim3D: Boolean read FChartDim3D write FChartDim3D;
    property ChartShowLegend: Boolean read FChartShowLegend write FChartShowLegend;
    property ChartShowAxis: Boolean read FChartShowAxis write FChartShowAxis;
    property ReprintOnOverFlow;
    property ShiftWith;
    property BandAlign;
    property LeftFrame;
    property RightFrame;
    property TopFrame;
    property BottomFrame;
    property FillColor;
    property DirectDraw: Boolean read GetDirectDraw write SetDirectDraw;
    property PrintFrame;
    property Printable;
  end;

  { TRMChartForm }
  TRMDBChartForm = class(TForm)
    Page1: TPageControl;
    Tab1: TTabSheet;
    gpbSeriesType: TGroupBox;
    Tab2: TTabSheet;
    btnOk: TButton;
    btnCancel: TButton;
    gpbSeriesOptions: TGroupBox;
    chkSeriesMultiColor: TCheckBox;
    chkSeriesShowMarks: TCheckBox;
    Tab3: TTabSheet;
    gpbMarks: TGroupBox;
    rdbStyle1: TRadioButton;
    rdbStyle2: TRadioButton;
    rdbStyle3: TRadioButton;
    rdbStyle4: TRadioButton;
    rdbStyle5: TRadioButton;
    TabSheet1: TTabSheet;
    ListBox1: TListBox;
    gpbChartOptions: TGroupBox;
    chkChartShowLegend: TCheckBox;
    chkChartShowAxis: TCheckBox;
    PopupMenu1: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    chkChartDim3D: TCheckBox;
    EditTitle1: TMenuItem;
    N1: TMenuItem;
    MoveUp1: TMenuItem;
    MoveDown1: TMenuItem;
    gpbObjects: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Label6: TLabel;
    ImageList1: TImageList;
    cmbSeriesType: TComboBox;
    cmbLegend: TComboBox;
    cmbValue: TComboBox;
    cmbLabel: TComboBox;
    cmbDataSet: TComboBox;
    Label7: TLabel;
    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 Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cmbSeriesTypeDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure cmbDataSetChange(Sender: TObject);
    procedure cmbDataSetDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
    FChartView: TDBRMChartView;
    FReport: TRMReport;
    FSeries: TRMChartSeries;
    FBtnColor: TRMColorPickerButton;
    FDataSetBMP, FFieldBMP: TBitmap;

    procedure Localize;
    procedure LoadSeriesOptions;
    procedure SaveSeriesOptions;
  public
    { Public declarations }
  end;

  TRMCustomDBTeeChartUIClass = class of TRMCustomDBTeeChartUI;

  TRMCustomDBTeeChartUI = class
  public
    class procedure Edit(aTeeChart: TCustomChart); virtual;
  end;

  {TRMTeeChartUIPlugIn }
  TRMTeeChartUIPlugIn = class
  private
    class function GetChartUIClass(aTeeChart: TCustomChart): TRMCustomDBTeeChartUIClass;
  public
    class procedure Register(aChartUIClass: TRMCustomDBTeeChartUIClass);
    class procedure UnRegister(aChartUIClass: TRMCustomDBTeeChartUIClass);
    class procedure Edit(aTeeChart: TCustomChart);
  end; {class, TRMTeeChartUIPlugIn}
{$ENDIF}

implementation

{$IFDEF TeeChart}
uses Math, RM_Utils, RM_Const, RM_Const1, RMInterpreter_Chart;

{$R *.DFM}

const
  flChartUseChartSetting = $2;
  flChartDirectDraw = $4;

type
  THackPage = class(TRMCustomPage)
  end;

  THackView = class(TRMView)
  end;

  TSeriesClass = class of TChartSeries;

const
  ChartTypes: array[0..5] of TSeriesClass =
  (TLineSeries, TAreaSeries, TPointSeries, TBarSeries, THorizBarSeries, TPieSeries);

var
  uDBChartUIClassList: TList;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMChartSeries }

constructor TRMChartSeries.Create;
begin
  inherited Create;

  FDataSet := '';
  FColored := True;
  FValueView := '';
  FLegendView := '';
  FTitle := '';
  FColor := clTeeColor;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDBRMChartView }

constructor TDBRMChartView.Create;
begin
  inherited Create;
  BaseName := 'DBChart';
//  WantHook := True;
  UseChartSetting := False;

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

  FChartDim3D := True;
  FChartShowLegend := True;
  FPrintType := rmptMetafile;

  FPicture := TMetafile.Create;
  FList := TList.Create;
end;

destructor TDBRMChartView.Destroy;
begin
  Clear;
  if RMDialogForm <> nil then
  begin
    FDBChart.Free;
    FDBChart := nil;
  end;
  FPicture.Free;
  FList.Free;
  inherited Destroy;
end;

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

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

function TDBRMChartView.AddSeries: TRMChartSeries;
var
  liSeries: TRMChartSeries;

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

      if liFlag then
      begin
        liSeries.Title := listr;
        Break;
      end;
    end;
  end;

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

procedure TDBRMChartView.DeleteSeries(Index: Integer);
begin
  if (Index >= 0) and (Index < FList.Count) then
  begin
    TRMChartSeries(FList[Index]).Free;
    FList.Delete(Index);
  end;
end;

function TDBRMChartView.GetSeries(Index: Integer): TRMChartSeries;
begin
  Result := nil;
  if (Index >= 0) and (Index < FList.Count) then
    Result := TRMChartSeries(FList[Index]);
end;

procedure TDBRMChartView.AssignChart(AChart: TCustomChart);
var
  liSeries: TChartSeries;
  liSeriesClass: TChartSeriesClass;
  i: Integer;
begin
  Clear;
  FDBChart.RemoveAllSeries;
  FDBChart.Assign(AChart);
  for i := 0 to AChart.SeriesCount - 1 do
  begin
    liSeriesClass := TChartSeriesClass(AChart.Series[i].ClassType);
    liSeries := liSeriesClass.Create(FDBChart);
    liSeries.Assign(aChart.Series[i]);
    FDBChart.AddSeries(liSeries);
  end;

  FDBChart.Name := '';
  for i := 0 to FDBChart.SeriesList.Count - 1 do
    FDBChart.SeriesList[i].Name := '';
  Memo.Clear;
  FPicture.Clear;
end;

procedure TDBRMChartView.ShowChart;
var
  i: Integer;
  lMetafile: TMetafile;
  lBitmap: TBitmap;
  lChartSeries: TRMChartSeries;
  lFlag: Boolean;

  procedure _SetChartProp;
  begin
    FDBChart.View3D := ChartDim3D;
    FDBChart.Legend.Visible := ChartShowLegend;
    FDBChart.AxisVisible := ChartShowAxis;
    if not UseChartSetting then
    begin
      FDBChart.RemoveAllSeries;
      FDBChart.Frame.Visible := False;
      FDBChart.LeftWall.Brush.Style := bsClear;
      FDBChart.BottomWall.Brush.Style := bsClear;

      FDBChart.Legend.Font.Charset := rmCharset;
      FDBChart.BottomAxis.LabelsFont.Charset := rmCharset;
      FDBChart.LeftAxis.LabelsFont.Charset := rmCharset;
      FDBChart.TopAxis.LabelsFont.Charset := rmCharset;
      FDBChart.BottomAxis.LabelsFont.Charset := rmCharset;
{$IFDEF Delphi4}
      FDBChart.BackWall.Brush.Style := bsClear;
      FDBChart.View3DOptions.Elevation := 315;
      FDBChart.View3DOptions.Rotation := 360;
{$ENDIF}
    end;
  end;

  procedure _PaintChart;
  var
    SaveDx, SaveDy: Integer;
  begin
    if FillColor = clNone then
      DBChart.Color := clWhite
    else
      DBChart.Color := FillColor;

    SaveDX := RMToScreenPixels(mmSaveWidth, rmutMMThousandths);