rm_chart.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{         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, TeeProcs, TeEngine, Chart, Series, StdCtrls, ComCtrls, Menus,
  Buttons, RM_Class;

type
  TRMChartOptions = packed record
    ChartType: Byte;
    Dim3D, IsSingle, ShowLegend, ShowAxis, ShowMarks, Colored: Boolean;
    MarksStyle: Byte;
    Top10Num: Integer;
    Reserved: array[0..35] of Byte;
  end;

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

  {TRMChartView}
  TRMChartView = class(TRMView)
  private
    FChart: TChart;
    FPicture: TMetafile;
    FCurStr: Integer;
    FLastLegend: string;
    function ShowChart: Boolean;
    procedure ChartEditor(Sender: TObject);
  protected
  	function GetViewCommon: string; override;
  public
    ChartOptions: TRMChartOptions;
    LegendObj, ValueObj, Top10Label: string;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(Canvas: 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 OnHook(View: TRmView); override;
    procedure ShowEditor; override;
    procedure AssignChart(AChart: TCustomChart);
    property Chart: TChart read FChart;
  end;

  TRMChartForm = class(TForm)
    Page1: TPageControl;
    Tab1: TTabSheet;
    GroupBox1: TGroupBox;
    Tab2: TTabSheet;
    btnOk: TButton;
    btnCancel: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    E1: TEdit;
    Label2: TLabel;
    E2: TEdit;
    GroupBox3: TGroupBox;
    CB1: TCheckBox;
    CB2: TCheckBox;
    CB3: TCheckBox;
    CB4: TCheckBox;
    CB6: TCheckBox;
    CB5: TCheckBox;
    Tab3: TTabSheet;
    GroupBox4: TGroupBox;
    RB1: TRadioButton;
    RB2: TRadioButton;
    RB3: TRadioButton;
    RB4: TRadioButton;
    RB5: TRadioButton;
    GroupBox5: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    E3: TEdit;
    E4: TEdit;
    Label5: TLabel;
    SB1: TSpeedButton;
    SB4: TSpeedButton;
    SB2: TSpeedButton;
    SB6: TSpeedButton;
    SB5: TSpeedButton;
    SB3: TSpeedButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure Localize;
  public
    { Public declarations }
  end;
{$ENDIF}

implementation

{$IFDEF TeeChart}
uses RM_Intrp, RM_Utils, RM_Const, RM_CmpReg, TeeConst;

{$R *.DFM}

type
  THackView = class(TRMView)
  end;

  TSeriesClass = class of TChartSeries;

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

function ExtractFieldName(const Fields: string; var Pos: Integer): string;
var
  i: Integer;
begin
  i := Pos;
  while (i <= Length(Fields)) and (Fields[i] <> ';') do Inc(i);
  Result := Copy(Fields, Pos, i - Pos);
  if (i <= Length(Fields)) and (Fields[i] = ';') then Inc(i);
  Pos := i;
end;

{=============================================================================}
{=============================================================================}
{ TRMChartView }
constructor TRMChartView.Create;
begin
  inherited Create;
  FChart := TChart.Create(RMDialogForm);
  with FChart do
  begin
    Parent := RMDialogForm;
    Visible := False;
    BevelInner := bvNone;
    BevelOuter := bvNone;
  end;
  with ChartOptions do
  begin
    Dim3D := True;
    IsSingle := True;
    ShowLegend := True;
    ShowMarks := True;
    Colored := True;
  end;
  FPicture := TMetafile.Create;
  BaseName := 'Chart';
  Flags := Flags or flWantHook;
end;

destructor TRMChartView.Destroy;
begin
  if RMDialogForm <> nil then
    FChart.Free;
  FPicture.Free;
  inherited Destroy;
end;

procedure TRMChartView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Chart', [RMdtHasEditor, RMdtOneObject], ChartEditor);

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

procedure TRMChartView.AssignChart(AChart: TCustomChart);
var
  tmpSeries: TChartSeries;
  tmpS: TChartSeriesClass;
  i: Integer;
begin
  FChart.RemoveAllSeries;
  FChart.Assign(AChart);
  for i := 0 to AChart.SeriesCount - 1 do
  begin
    tmpS := TChartSeriesClass(AChart.Series[i].ClassType);
    tmpSeries := tmpS.Create(FChart);
    tmpSeries.AssignValues(AChart.Series[i]);
    tmpSeries.Marks.Assign(AChart.Series[i].Marks);
    tmpSeries.SeriesColor := AChart.Series[i].SeriesColor;
    FChart.AddSeries(tmpSeries);
  end;
  Memo.Clear;
  ValueObj := ''; LegendObj := '';
  FPicture.Clear;
end;

function TRMChartView.ShowChart: Boolean;
var
  i, j, c1, c2: Integer;
  LegS, ValS, s: string;
  Ser: TChartSeries;
  EMF: TMetafile;

  procedure PaintChart;
  begin
    with Canvas do
    begin
		  if FillColor = clNone then
      	Chart.Color := clWhite
      else
	      Chart.Color := FillColor;
  	  EMF := Chart.TeeCreateMetafile(False, Rect(0, 0, SaveDX, SaveDY));
      StretchDraw(DRect1, EMF);
      EMF.Free;
    end;
  end;

  function Str2Float(s: string): Double;
  begin
    s := Trim(s);
    while (Length(s) > 0) and not (s[1] in ['0'..'9']) do
      s := Copy(s, 2, 255); // trim all non-digit chars at the begin
    while (Length(s) > 0) and not (s[Length(s)] in ['0'..'9']) do
      s := Copy(s, 1, Length(s) - 1); // trim all non-digit chars at the end
    while Pos(ThousandSeparator, s) <> 0 do
      Delete(s, Pos(ThousandSeparator, s), 1);
    Result := 0;
    try
      Result := StrToFloat(s);
    except
    end;
  end;

  procedure SortValues(var LegS, ValS: string);
  var
    i, j: Integer;
    sl: TStringList;
    s: string;
    d: Double;
  begin
    sl := TStringList.Create;
    sl.Sorted := True;

    i := 1; j := 1;
    while i <= Length(LegS) do
    begin
      sl.Add(SysUtils.Format('%12.3f', [Str2Float(ExtractFieldName(ValS, j))]) + '=' +
        ExtractFieldName(LegS, i));
    end;

    LegS := ''; ValS := '';
    for i := 1 to ChartOptions.Top10Num do
    begin
      s := sl[sl.Count - i];
      ValS := ValS + Copy(s, 1, Pos('=', s) - 1) + ';';
      LegS := LegS + Copy(s, Pos('=', s) + 1, 255) + ';';
    end;

    i := sl.Count - ChartOptions.Top10Num - 1; d := 0;
    while i >= 0 do
    begin
      s := sl[i];
      d := d + Str2Float(Copy(s, 1, Pos('=', s) - 1));
      Dec(i);
    end;

    if Top10Label <> '' then
    begin
      LegS := LegS + Top10Label + ';';
      ValS := ValS + FloatToStr(d) + ';';
    end;
    sl.Free;
  end;

begin
  if (Memo.Count = 0) and (LegendObj = '') and (ValueObj = '') then
  begin
		if FPicture.Width = 0 then
    begin
	    PaintChart;
      Result := TRUE;
      Exit;
    end
    else
    begin
    	Canvas.StretchDraw(DRect1, FPicture);
      Result := TRUE;
      Exit;
    end;
  end;

  Result := False;
  Chart.RemoveAllSeries;
  with ChartOptions do
  begin
    Chart.Frame.Visible := False;
    Chart.LeftWall.Brush.Style := bsClear;
    Chart.BottomWall.Brush.Style := bsClear;

    Chart.View3D := Dim3D;
    Chart.Legend.Visible := ShowLegend;
{$IFNDEF Delphi2}
    Chart.Legend.Font.Charset := rmCharset;
    Chart.RightAxis.LabelsFont.Charset := rmCharset;
    Chart.LeftAxis.LabelsFont.Charset := rmCharset;
    Chart.TopAxis.LabelsFont.Charset := rmCharset;
    Chart.BottomAxis.LabelsFont.Charset := rmCharset;
{$ENDIF}
    Chart.AxisVisible := ShowAxis;
    Chart.View3DWalls := ChartType <> 5;
{$IFDEF Delphi4}
    Chart.BackWall.Brush.Style := bsClear;
    Chart.View3DOptions.Elevation := 315;
    Chart.View3DOptions.Rotation := 360;
    Chart.View3DOptions.Orthogonal := ChartType <> 5;
{$ENDIF}
  end;

  if Memo.Count > 0 then
    LegS := Memo[0]
  else
    LegS := '';
  if Memo.Count > 1 then
    ValS := Memo[1]
  else
    ValS := '';

  if (LegS = '') or (ValS = '') then Exit;
  if LegS[Length(LegS)] <> ';' then
    LegS := LegS + ';';
  if ValS[Length(ValS)] <> ';' then
    ValS := ValS + ';';

  if ChartOptions.IsSingle then
  begin
    Ser := ChartTypes[ChartOptions.ChartType].Create(Chart);
    Chart.AddSeries(Ser);
    if ChartOptions.Colored then