rm_chart.pas

这是一个功能强大

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

unit RM_Chart;

interface

{$I RM.inc}

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

type

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

  TRMChartSeriesDataType = (rmdtBandData, rmdtDBData, rmdtFixedData);
  TRMChartSeriesSortOrder = (rmsoNone, rmsoAscending, rmsoDescending);

  { TRMChartSeries }
  TRMChartSeries = class(TPersistent)
  private
    FXValues: array of Variant;
    FYValues: array of Variant;
    FXObject, FYObject, FTop10Label: string;
    FTitle: string;
    FColor: TColor;
    FChartType: Byte;
    FShowMarks, FColored: Boolean;
    FMarksStyle: Byte;
    FTop10Num: Integer;
    FDataType: TRMChartSeriesDataType;
    FSortOrder: TRMChartSeriesSortOrder;
    FDataSet: string;
  protected
  public
    constructor Create;
    procedure Init;
    procedure GetData(aReport: TRMReport);
  published
    property DataSet: string read FDataSet write FDataSet;
    property XObject: string read FXObject write FXObject;
    property YObject: string read FYObject write FYObject;
    property Top10Label: string read FTop10Label write FTop10Label;
    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;
    property Top10Num: Integer read FTop10Num write FTop10Num;
    property DataType: TRMChartSeriesDataType read FDataType write FDataType;
    property SortOrder: TRMChartSeriesSortOrder read FSortOrder write FSortOrder;
    property XValues: string read FXObject write FXObject;
    property YValues: string read FYObject write FYObject;
  end;

  {TRMChartView}
  TRMChartView = class(TRMReportView)
  private
    FPrintType: TRMPrintMethodType;
    FChart: TChart;
    FPicture: TMetafile;
    FSeriesList: TList;
    FChartDim3D, FChartShowLegend, FChartShowAxis: Boolean;
    FSaveMemo: string;

    procedure ShowChart;
    function GetUseChartSetting: Boolean;
    procedure SetUseChartSetting(Value: Boolean);
    function GetSeries(Index: Integer): TRMChartSeries;
    function GetDirectDraw: Boolean;
    procedure SetDirectDraw(Value: Boolean);
  protected
    procedure Prepare; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
    procedure GetEndPageData(aStream: TStream); override;
    function GetViewCommon: string; override;
    procedure ClearContents; override;
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    procedure OnHook(aView: TRmView); 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 ShowEditor; override;
    procedure AssignChart(AChart: TCustomChart);
    property Series[Index: Integer]: TRMChartSeries read GetSeries;
    property Chart: TChart read FChart;
  published
    property PrintType: TRMPrintMethodType read FPrintType write FPrintType;
    property UseChartSetting: Boolean read GetUseChartSetting write SetUseChartSetting;
    property UseDoublePass;
    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;
    property OnPreviewClick;
    property OnPreviewClickUrl;
  end;

  { TRMChartForm }
  TRMChartForm = class(TForm)
    Page1: TPageControl;
    btnOk: TButton;
    btnCancel: TButton;
    Tab3: TTabSheet;
    gpbMarks: TGroupBox;
    rdbStyle1: TRadioButton;
    rdbStyle2: TRadioButton;
    rdbStyle3: TRadioButton;
    rdbStyle4: TRadioButton;
    rdbStyle5: TRadioButton;
    TabSheet1: TTabSheet;
    btnCharUI: TButton;
    rdbDataSource: TRadioGroup;
    rdbSortType: TRadioGroup;
    GroupBox3: TGroupBox;
    btnAddSeries: TSpeedButton;
    btnDeleteSeries: TSpeedButton;
    TreeView1: TTreeView;
    Panel1: TPanel;
    ImageList2: TImageList;
    PopupSeries: TPopupMenu;
    mnuLine: TMenuItem;
    mnuArea: TMenuItem;
    mnuPoint: TMenuItem;
    mnuBar: TMenuItem;
    mnuHorizBar: TMenuItem;
    mnuPie: TMenuItem;
    mnuGantt: TMenuItem;
    mnuFastLine: TMenuItem;
    gpbChartOptions: TGroupBox;
    chkChartShowLegend: TCheckBox;
    chkChartShowAxis: TCheckBox;
    chkChartDim3D: TCheckBox;
    gpbSeriesType: TGroupBox;
    cmbSeriesType: TComboBox;
    gpbSeriesOptions: TGroupBox;
    chkSeriesMultiColor: TCheckBox;
    chkSeriesShowMarks: TCheckBox;
    gpbObjects: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    cmbLegend: TComboBox;
    cmbValue: TComboBox;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    cmbDataSet: TComboBox;
    GroupBox1: TGroupBox;
    lblXValue: TLabel;
    lblYValue: TLabel;
    edtXValues: TEdit;
    edtYValues: TEdit;
    gpbTopGroup: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    editTop10Num: TEdit;
    edtTop10Label: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Add1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MoveUp1Click(Sender: TObject);
    procedure MoveDown1Click(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure btnCharUIClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cmbSeriesTypeDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure rdbDataSourceClick(Sender: TObject);
    procedure cmbDataSetChange(Sender: TObject);
    procedure cmbDataSetDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure TreeView1Click(Sender: TObject);
    procedure mnuLineClick(Sender: TObject);
    procedure cmbSeriesTypeClick(Sender: TObject);
    procedure chkChartShowAxisClick(Sender: TObject);
    procedure TreeView1Editing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure TreeView1Edited(Sender: TObject; Node: TTreeNode;
      var S: String);
  private
    { Private declarations }
    FChartView: TRMChartView;
    FSeries: TRMChartSeries;
    FBtnColor: TRMColorPickerButton;
    FReport: TRMReport;
    FDataSetBMP, FFieldBMP: TBitmap;
    FInspector: TELPropertyInspector;
    FOldSelected: TTreeNode;

    procedure Localize;
    procedure SetInspControls;
    procedure LoadSeriesOptions;
    procedure SaveSeriesOptions;
    procedure SetSeriesType(aNode: TTreeNode; aChartType: Integer);
    procedure OnColorChangeEvent(Sender: TObject);
    procedure OnAfterModifyEvent(Sender: TObject; const aPropName, aPropValue: string);
    procedure SetTreeView;
  public
    { Public declarations }
  end;

  TRMCustomTeeChartUIClass = class of TRMCustomTeeChartUI;

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

  {TRMTeeChartUIPlugIn }
  TRMTeeChartUIPlugIn = class
  private
    class function GetChartUIClass: TRMCustomTeeChartUIClass;
  public
    class procedure Register(aChartUIClass: TRMCustomTeeChartUIClass);
    class procedure UnRegister(aChartUIClass: TRMCustomTeeChartUIClass);
    class procedure Edit(aTeeChart: TCustomChart);
    class function HaveChartEditor: Boolean;
  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..7] of TSeriesClass =
  (TLineSeries, TAreaSeries, TPointSeries, TBarSeries, THorizBarSeries,
    TPieSeries, TGanttSeries, TFastLineSeries);

var
  uChartUIClassList: TList;

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

constructor TRMChartSeries.Create;
begin
  inherited Create;

  FColored := False;
  FYObject := '';
  FXObject := '';
  FTop10Label := '';
  FTop10Num := 0;
  FTitle := '';
  FColor := clTeeColor;
  FDataType := rmdtBandData;
  FSortOrder := rmsoNone;
end;

procedure TRMChartSeries.Init;
begin
  SetLength(FXValues, 0);
  SetLength(FYValues, 0);
end;

function _ExtractStr(const aStr: string; var aPos: Integer): string;
var
  i: Integer;
begin
  i := aPos;
  while (i <= Length(aStr)) and (aStr[i] <> ';') do
    Inc(i);

  Result := Copy(aStr, aPos, i - aPos);
  if (i <= Length(aStr)) and (aStr[i] = ';') then
    Inc(i);

  aPos := i;
end;

procedure TRMChartSeries.GetData(aReport: TRMReport);

  procedure _GetDataSetData;
  var
    lRMDataSet: TRMDataSet;
    lDataSet: TDataSet;
    lStr: string;
    lXField, lYField: TField;
  begin
    lRMDataSet := aReport.Dictionary.FindDataSet(aReport.Dictionary.RealDataSetName[FDataSet],
      aReport.Owner, lStr);
    if not (lRMDataSet is TRMDBDataSet) or (TRMDBDataSet(lRMDataSet).DataSet = nil) then Exit;

    lDataSet := TRMDBDataSet(lRMDataSet).DataSet;
    lStr := aReport.Dictionary.RealFieldName[lRMDataSet, XObject];
    if lStr <> '' then
      lXField := lDataSet.FieldByName(lStr)
    else
      lXField := nil;

    lStr := aReport.Dictionary.RealFieldName[lRMDataSet, YObject];
    if lStr <> '' then
      lYField := lDataSet.FieldByName(lStr)
    else
      lYField := nil;

    lDataSet.First;
    while not lDataSet.Eof do
    begin
      if lXField <> nil then
      begin
        SetLength(FXValues, Length(FXValues) + 1);
        FXValues[Length(FXValues) - 1] := lXField.AsString;
      end;

      if lYField <> nil then
      begin
        SetLength(FYValues, Length(FYValues) + 1);
        lStr := lYField.AsString;
        if RMIsValidFloat(lStr) then
          FYValues[Length(FYValues) - 1] := RMStrToFloat(lStr)
        else
          FYValues[Length(FYValues) - 1] := 0;
      end;

      lDataSet.Next;
    end;
  end;

  procedure _GetFixedData;
  var
    lPos: Integer;
    lStr, lStr1: string;
  begin
    lPos := 1;
    lStr := XObject;
    while lPos <= Length(lStr) do
    begin
      SetLength(FXValues, Length(FXValues) + 1);
      FXValues[Length(FXValues) - 1] := _ExtractStr(lStr, lPos);
    end;

    lPos := 1;
    lStr := YObject;
    while lPos <= Length(lStr) do
    begin
      lStr1 := _ExtractStr(lStr, lPos);
      SetLength(FYValues, Length(FYValues) + 1);
      if RMIsValidFloat(lStr1) then
        FYValues[Length(FYValues) - 1] := RMStrToFloat(lStr1)
      else
        FYValues[Length(FYValues) - 1] := 0;
    end;
  end;

  procedure _SortData;
  var
    i, lOffset: Integer;
    lStrList: TStringList;
  begin
    if SortOrder = rmsoNone then Exit;

    lStrList := TStringList.Create;
    try
      lStrList.Duplicates := dupAccept;
      for i := 0 to High(FYValues) do
      begin
        lStrList.Add(Format('%18.2f=%s', [Double(FYValues[i]), string(FXValues[i])]));
      end;

      lStrList.Sort;
      for i := 0 to High(FYValues) do
      begin
        if SortOrder = rmsoAscending then
          lOffset := i
        else
          lOffset := High(FYValues) - i;

        FYValues[lOffset] := RMStrToFloat(lStrList.Names[i]);
{$IFDEF COMPILER7_UP}
        FXValues[lOffset] := lStrList.ValueFromIndex[i];
{$ELSE}
        FXValues[lOffset] := lStrList.Values[lStrList.Names[i]];
{$ENDIF}
      end;
    finally
      lStrList.Free;
    end;
  end;

  procedure _SetTop10Value;
  var
    i: Integer;
    lTotalValue: Double;
  begin
    if (Top10Num < 1) or (Top10Num >= Length(FYValues)) or (Top10Label = '') then Exit;

    lTotalValue := 0;
    for i := Top10Num - 1 to High(FYValues) do
      lTotalValue := lTotalValue + FYValues[i];

    SetLength(FXValues, Top10Num);
    SetLength(FYValues, Top10Num);

    FXValues[Top10Num - 1] := Top10Label;
    FYValues[Top10Num - 1] := lTotalValue;
  end;

begin
  case DataType of
    rmdtDBData:
      begin
        Init;
        _GetDataSetData;
      end;
    rmdtBandData:
      begin
      end;
    rmdtFixedData:
      begin
        Init;
        _GetFixedData;
      end;
  end;

  if Length(FXValues) < Length(FYValues) then
    SetLength(FYValues, Length(FXValues))
  else if Length(FXValues) > Length(FYValues) then
    SetLength(FXValues, Length(FYValues));

  _SortData;
  _SetTop10Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMChartView }

constructor TRMChartView.Create;
begin
  inherited Create;