dbchart.pas

TeeChart7Source 控件

{******************************************}
{ TDBChart Component                       }
{ Copyright (c) 1995-2004 by David Berneda }
{ All rights Reserved                      }
{******************************************}
unit DBChart;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QMenus, QForms, QDialogs, QExtCtrls, QStdCtrls,
  {$ELSE}
  Graphics, Controls, Menus, Forms, Dialogs, ExtCtrls, StdCtrls,
  {$ENDIF}
  Chart, DB, TeeProcs, TeCanvas, TeEngine;

type
  DBChartException=class(Exception);

  TTeeDBGroup=(dgHour,dgDay,dgWeek,dgWeekDay,dgMonth,dgQuarter,dgYear,dgNone);

  TListOfDataSources=class(TList)
  private
    procedure Put(Index:Integer; Value:TDataSource);
    function Get(Index:Integer):TDataSource;
  public
    Procedure Clear; override;
    property DataSource[Index:Integer]:TDataSource read Get write Put; default;
  end;

  TCustomDBChart=class;

  TProcessRecordEvent=Procedure(Sender:TCustomDBChart; DataSet:TDataSet) of object;

  TCustomDBChart = class(TCustomChart)
  private
    FAutoRefresh     : Boolean;
    FRefreshInterval : Integer;
    FShowGlassCursor : Boolean;
    FOnProcessRecord : TProcessRecordEvent;
    { internal }
    IUpdating        : Boolean;
    ITimer           : TTimer;
    IDataSources     : TListOfDataSources;
    Procedure DataSourceCheckDataSet(ADataSet:TDataSet);
    Procedure DataSourceCloseDataSet(ADataSet:TDataSet);
    Procedure CheckDataSet(ADataSet:TDataSet; ASeries:TChartSeries=nil);
    Procedure CheckNewDataSource(ADataSet:TDataSet; SingleRow:Boolean);
    Procedure SetRefreshInterval(Value:Integer);
    Procedure CheckTimer;
    Procedure OnRefreshTimer(Sender:TObject);
  protected
    procedure RemovedDataSource( ASeries: TChartSeries;
                                 AComponent: TComponent ); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Procedure Assign(Source:TPersistent); override;
    Procedure CheckDatasource(ASeries:TChartSeries); override;
    Function IsValidDataSource(ASeries:TChartSeries; AComponent:TComponent):Boolean; override;

    Procedure FillValueSourceItems( AValueList:TChartValueList; Proc:TGetStrProc); override;
    Procedure FillSeriesSourceItems( ASeries:TChartSeries; Proc:TGetStrProc); override;

    Procedure RefreshDataSet(ADataSet:TDataSet; ASeries:TChartSeries);
    Procedure RefreshData;
    { properties }
    property AutoRefresh:Boolean read FAutoRefresh write FAutoRefresh default True;
    property RefreshInterval:Integer read FRefreshInterval write SetRefreshInterval default 0;
    property ShowGlassCursor:Boolean read FShowGlassCursor write FShowGlassCursor default True;
    { events }
    property OnProcessRecord:TProcessRecordEvent read FOnProcessRecord
                                                 write FOnProcessRecord;
  published
  end;

  TDBChart=class(TCustomDBChart)
  published
    { TCustomDBChart properties }
    property AutoRefresh;
    property RefreshInterval;
    property ShowGlassCursor;
    { TCustomDBChart events }
    property OnProcessRecord;

    { TCustomChart Properties }
    property AllowPanning;
    property BackImage;
    property BackImageInside;
    property BackImageMode;
    property BackImageTransp;
    property BackWall;
    property Border;
    property BorderRound;
    property BottomWall;
    property Foot;
    property Gradient;
    property LeftWall;
    property MarginBottom;
    property MarginLeft;
    property MarginRight;
    property MarginTop;
    property MarginUnits;
    property PrintProportional;
    property RightWall;
    property SubFoot;
    property SubTitle;
    property Title;

    { TCustomChart Events }
    property OnAllowScroll;
    property OnClickAxis;
    property OnClickBackground;
    property OnClickLegend;
    property OnClickSeries;
    property OnClickTitle;
    property OnGetLegendPos;
    property OnGetLegendRect;
    property OnScroll;
    property OnUndoZoom;
    property OnZoom;

    { TCustomAxisPanel properties }
    property AxisBehind;
    property AxisVisible;
    property BottomAxis;
    property Chart3DPercent;
    property ClipPoints;
    property CustomAxes;
    property DepthAxis;
    property DepthTopAxis;
    property Frame;
    property LeftAxis;
    property Legend;
    property MaxPointsPerPage;
    property Monochrome;
    property Page;
    property RightAxis;
    property ScaleLastPage;
    property SeriesList;
    property Shadow;
    property TopAxis;
    property View3D;
    property View3DOptions;
    property View3DWalls;
    property Zoom;

    { TCustomAxisPanel events }
    property OnAfterDraw;
    property OnBeforeDrawAxes;
    property OnBeforeDrawChart;
    property OnBeforeDrawSeries;
    property OnGetAxisLabel;
    property OnGetLegendText;
    property OnGetNextAxisLabel;
    property OnPageChange;

    { TPanel properties }
    property Align;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;

    {$IFDEF CLX}
    property Bitmap;
    {$ENDIF}

    property BorderWidth;
    property Color;
    {$IFNDEF CLX}
    property DragCursor;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Anchors;
    {$IFNDEF CLX}
    property AutoSize;
    {$ENDIF}
    property Constraints;
    {$IFNDEF CLX}
    property DragKind;
    property Locked;
    {$ENDIF}

    { TPanel events }
    property OnClick;
    {$IFDEF D5}
    property OnContextPopup;
    {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    {$IFNDEF CLX}
    property OnCanResize;
    {$ENDIF}
    property OnConstrainedResize;
    {$IFNDEF CLX}
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
    {$ENDIF}

    {$IFDEF K3}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
  end;

  TTeeFieldType=(tftNumber,tftDateTime,tftText,tftNone);

{ given a VCL "database field type", this function returns
  a more simplified "type": (number, date, text) }
Function TeeFieldType(AType:TFieldType):TTeeFieldType;

{ Returns the ISO- Week number (from 1 to 52) of a given "ADate" parameter,
  and decrements "Year" if it's the first week of the year. }
Function DateToWeek(ADate:TDateTime; Var Year:Word):Integer;

{ same as DateToWeek, using a different algorithm
  (compatible with TeeChart version 4 }
Function DateToWeekOld(Const ADate:TDateTime; Var Year:Word):Integer;

{ internal, used by DBChart Summary feature }
Function TeeGetDBPart(Num:Integer; St:String):String;
Function StrToDBGroup(St:String):TTeeDBGroup;
Function StrToDBOrder(St:String):TChartListOrder;

type
  TCheckDataSetEvent=procedure(DataSet:TDataSet) of object;

  TDBChartDataSource=class(TDataSource)
  private
    FDBChart   : TCustomDBChart;
    FWasActive : Boolean;
    Procedure DataSourceRowChange(Sender:TObject; Field:TField);
    Procedure DataSourceStateChange(Sender:TObject);
    Procedure DataSourceUpdateData(Sender:TObject);
  protected
    OnCheckDataSet : TCheckDataSetEvent;
    OnCloseDataSet : TCheckDataSetEvent;
    Procedure SetDataSet(Value:TDataSet; SingleRow:Boolean=False);
  end;

Procedure FillDataSetFields(DataSet:TDataSet; Proc:TGetStrProc);

implementation

Uses TeeConst, TypInfo;

{$IFDEF CLR}
type
  TBookMark=IntPtr;  // Pending fix in Borland.VclDBRtl.dll
{$ENDIF}

{ TDBChartDataSource }
Procedure TDBChartDataSource.SetDataSet(Value:TDataSet; SingleRow:Boolean=False);
Begin
  DataSet:=Value;
  FWasActive:=DataSet.Active;

  {$IFDEF CLR}
  Include(OnStateChange,DataSourceStateChange);
  Include(OnUpdateData,DataSourceUpdateData);
  if SingleRow then Include(OnDataChange,DataSourceRowChange);

  {$ELSE}

  OnStateChange:=DataSourceStateChange;
  OnUpdateData:=DataSourceUpdateData;
  if SingleRow then OnDataChange:=DataSourceRowChange;
  {$ENDIF}
end;

Procedure TDBChartDataSource.DataSourceRowChange(Sender:TObject; Field:TField);
begin
  if Assigned(FDBChart) then
     if not FDBChart.IUpdating then
        With TDBChartDataSource(Sender) do OnCheckDataSet(DataSet);
end;

Procedure TDBChartDataSource.DataSourceUpdateData(Sender:TObject);
Begin
  With TDBChartDataSource(Sender) do
  if State= {$IFDEF CLR}TDataSetState.{$ENDIF}dsBrowse then OnCheckDataSet(DataSet)
                    else FWasActive:=False;
End;

Procedure TDBChartDataSource.DataSourceStateChange(Sender:TObject);
Begin
  With TDBChartDataSource(Sender) do
  if State={$IFDEF CLR}TDataSetState.{$ENDIF}dsInactive then
  Begin
    FWasActive:=False;
    if Assigned(OnCloseDataSet) then OnCloseDataSet(DataSet);
  end
  else
  if (State={$IFDEF CLR}TDataSetState.{$ENDIF}dsBrowse) and (not FWasActive) then
  Begin
    OnCheckDataSet(DataSet);
    FWasActive:=True;
  end;
end;

{ TListOfDataSources }
Procedure TListOfDataSources.Clear;
var t : Integer;
begin
  for t:=0 to Count-1 do DataSource[t].Free;
  inherited;
end;

procedure TListOfDataSources.Put(Index:Integer; Value:TDataSource);
begin
  inherited Items[Index]:=Value;
end;

function TListOfDataSources.Get(Index:Integer):TDataSource;
begin
  result:=TDataSource(inherited Items[Index]);
end;

{ TDBChart }
Constructor TCustomDBChart.Create(AOwner: TComponent);
begin
  inherited;
  IDataSources:=TListOfDataSources.Create;
  FAutoRefresh:=True;
  FShowGlassCursor:=True;
  ITimer:=nil;
  IUpdating:=False;
end;

Destructor TCustomDBChart.Destroy;
begin