teetools.pas

TeeChart7Source 控件

{**********************************************}
{   TeeChart Tools                             }
{   Copyright (c) 1999-2004 by David Berneda   }
{**********************************************}
unit TeeTools;
{$I TeeDefs.inc}

interface

// This unit defines and implements several "Chart Tools".
// Tools appear at the Chart editor "Tools" tab and can be added
// both at design-time and run-time.

// The purpose of a "tool" is to perform some generic functionality
// outside the Chart or Series code. Chart Tools are notified of
// chart drawing (repaints) and chart mouse events (move, up, down).

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     SysUtils, Classes,
     {$IFDEF CLX}
     QGraphics, QControls,
     {$ELSE}
     Graphics, Controls,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     TeCanvas, TeeProcs, TeEngine, Chart;

// Default number of pixels to consider a line is "clicked"
// (ie: when the mouse is more or less 3 pixels from a line)
Const TeeClickTolerance = 3;

Type
  // Style of cursor tool
  TCursorToolStyle=(cssHorizontal,cssVertical,cssBoth);

  TCursorTool=class;

  TCursorClicked=(ccNone,ccHorizontal,ccVertical,ccBoth);

  TCursorToolChangeEvent=procedure( Sender:TCursorTool;
                                    x,y:Integer;
                                    Const XValue,YValue:Double;
                                    Series:TChartSeries;
                                    ValueIndex:Integer) of object;

  TCursorToolGetAxisRect=procedure(Sender:TCursorTool; Var Rect:TRect) of object;

  // Cursor tool, use it to draw a draggable line (cursor)
  TCursorTool=class(TTeeCustomToolSeries)
  private
    FFollowMouse   : Boolean;
    FOnChange      : TCursorToolChangeEvent;
    FOnGetAxisRect : TCursorToolGetAxisRect;
    FOnSnapChange  : TCursorToolChangeEvent;

    FSnap          : Boolean;
    FStyle         : TCursorToolStyle;
    FUseChartRect  : Boolean;
    FUseSeriesZ    : Boolean;  // 7.0

    IDragging      : TCursorClicked;
    IOldSnap       : Integer;

    Procedure CalcValuePositions(X,Y:Integer);
    procedure DoChange;
    Function GetAxisRect:TRect;
    Function InAxisRectangle(x,y:Integer):Boolean;
    Procedure SetStyle(Value:TCursorToolStyle);
    procedure SetUseChartRect(const Value: Boolean);
    procedure SetUseSeriesZ(const Value: Boolean);
    procedure SetXValue(const Value: Double);
    procedure SetYValue(const Value: Double);
    Function Z:Integer;
  protected
    IXValue     : Double;  { 5.01 }
    IYValue     : Double;
    IPoint      : TPoint;

    Procedure CalcScreenPositions; { 5.01 }
    Procedure Changed(SnapPoint:Integer); virtual;
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class Function GetEditorClass:String; override;
    procedure SetSeries(const Value: TChartSeries); override;
  public
    Constructor Create(AOwner:TComponent); override;

    Function Clicked(x,y:Integer):TCursorClicked;
    class Function Description:String; override;
    Function NearestPoint(AStyle:TCursorToolStyle; Var Difference:Double):Integer;
    Function SnapToPoint:Integer;
    procedure RedrawCursor;

    property UseChartRect:Boolean read FUseChartRect write SetUseChartRect default False;
    property XValue:Double read IXValue write SetXValue;
    property YValue:Double read IYValue write SetYValue;
    property OnGetAxisRect:TCursorToolGetAxisRect read FOnGetAxisRect write FOnGetAxisRect;
  published
    property Active;
    property FollowMouse:Boolean read FFollowMouse write FFollowMouse default False;
    property Pen;
    property Series;
    property Snap:Boolean read FSnap write FSnap default False;
    property Style:TCursorToolStyle read FStyle write SetStyle default cssBoth;
    property UseSeriesZ:Boolean read FUseSeriesZ write SetUseSeriesZ default False;
    { events }
    property OnChange:TCursorToolChangeEvent read FOnChange write FOnChange;
    property OnSnapChange:TCursorToolChangeEvent read FOnSnapChange write FOnSnapChange;  // 7.0
  end;

  // Drag Marks tool, use it to allow the end-user to drag series Marks
  TDragMarksTool=class(TTeeCustomToolSeries)
  private
    { internal }
    IOldX    : Integer;
    IOldY    : Integer;
    IPosition: TSeriesMarkPosition;
    ISeries  : TChartSeries;
  protected
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class Function GetEditorClass:String; override;
  public
    class Function Description:String; override;
  published
    property Active;
    property Series;
  end;

  TAxisArrowTool=class;

  TAxisArrowClickEvent=procedure(Sender:TAxisArrowTool; AtStart:Boolean) of object;

  TAxisArrowToolPosition=(aaStart,aaEnd,aaBoth);

  // Axis Arrow tool, use it to display small "arrows" at start and end
  // positions of an axis. These arrows can be clicked to scroll the axis.
  TAxisArrowTool=class(TTeeCustomToolAxis)
  private
    FLength        : Integer;
    FPosition      : TAxisArrowToolPosition;
    FScrollPercent : Integer;
    FScrollInverted: Boolean;

    FOnClick       : TAxisArrowClickEvent;

    Function ClickedArrow(x,y:Integer):Integer;
    procedure SetLength(const Value: Integer);
    procedure SetPosition(const Value: TAxisArrowToolPosition);
  protected
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner:TComponent); override;

    class Function Description:String; override;
  published
    property Active;
    property Position:TAxisArrowToolPosition read FPosition write SetPosition default aaBoth;
    property Axis;
    property Brush;
    property Length:Integer read FLength write SetLength default 16;
    property Pen;
    property ScrollInverted:Boolean read FScrollInverted write FScrollInverted default False;
    property ScrollPercent:Integer read FScrollPercent write FScrollPercent default 10;

    { events }
    property OnClick:TAxisArrowClickEvent read FOnClick write FOnClick;
  end;

  TAxisScrollTool=class(TTeeCustomToolAxis)
  private
    FScrollInverted : Boolean;

    OldX,
    OldY   : Integer;
    InAxis : TChartAxis;
  protected
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
  public
    class Function Description:String; override;
  published
    property Active;
    property Axis;
    property ScrollInverted:Boolean read FScrollInverted write FScrollInverted default False;
  end;

  TDrawLineTool=class;

  TDrawLineStyle=(dlLine,dlHorizParallel,dlVertParallel); { 5.03 }

  // Element of Lines collection in TDrawLineTool class
  TDrawLine=class(TCollectionItem)
  private
    FStyle : TDrawLineStyle;

    Function GetParent:TDrawLineTool;
    Function GetPen:TChartPen;
    function GetX0: Double;
    function GetX1: Double;
    function GetY0: Double;
    function GetY1: Double;
    Procedure SetStyle(Value:TDrawLineStyle);
    procedure SetX0(const Value: Double);
    procedure SetX1(const Value: Double);
    procedure SetY0(const Value: Double);
    procedure SetY1(const Value: Double);
  public
    EndPos   : TFloatPoint;
    StartPos : TFloatPoint;
    Constructor CreateXY(Collection:TCollection; Const X0,Y0,X1,Y1:Double);
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override; { 5.01 }
    Procedure DrawHandles;
    Function EndHandle:TRect;
    Function StartHandle:TRect;

    property Parent : TDrawLineTool read GetParent;
    property Pen    : TChartPen read GetPen;
  published
    property Style:TDrawLineStyle read FStyle write SetStyle default dlLine;
    property X0:Double read GetX0 write SetX0;
    property Y0:Double read GetY0 write SetY0;
    property X1:Double read GetX1 write SetX1;
    property Y1:Double read GetY1 write SetY1;
  end;

  // Collection of lines (TDrawLine) used in TDrawLineTool
  TDrawLines=class(TOwnedCollection)
  private
    Function Get(Index:Integer):TDrawLine;
    Procedure Put(Index:Integer; Const Value:TDrawLine);
  public
    Function Last:TDrawLine;
    property Line[Index:Integer]:TDrawLine read Get write Put; default;
  end;

  TDrawLineHandle=(chNone,chStart,chEnd,chSeries);

  TDrawLineSelecting=procedure( Sender:TDrawLineTool; Line:TDrawLine;
                                var AllowSelect:Boolean) of object;

  // Draw Line tool, use it to allow the end-user to draw, drag, select
  // and move lines.
  TDrawLineTool=class(TTeeCustomToolSeries)
  private
    FButton       : TMouseButton;
    FEnableDraw   : Boolean;
    FEnableSelect : Boolean;
    FLines        : TDrawLines;
    FOnDraggedLine: TNotifyEvent;
    FOnDragLine   : TNotifyEvent;
    FOnNewLine    : TNotifyEvent;
    FOnSelect     : TNotifyEvent;
    FOnSelecting  : TDrawLineSelecting;

    IDrawing  : Boolean;
    IPoint    : TPoint;
    ISelected : TDrawLine;
    Procedure DrawLine(Const StartPos,EndPos:TPoint; AStyle:TDrawLineStyle);
    Function InternalClicked(X,Y:Integer; AHandle:TDrawLineHandle):TDrawLine;
    Procedure SetEnableSelect(Value:Boolean);
    Procedure SetLines(Const Value:TDrawLines);
    Procedure SetSelected(Value:TDrawLine);
    Procedure RedrawLine(ALine:TDrawLine);
  protected
    IHandle   : TDrawLineHandle;
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               AButton:TMouseButton;
                               AShift: TShiftState; X, Y: Integer); override;
    Procedure ClipDrawingRegion; virtual;
    class function GetEditorClass: String; override;
  public
    FromPoint : TPoint;
    ToPoint   : TPoint;
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Function AxisPoint(Const P:TFloatPoint):TPoint;
    Function Clicked(X,Y:Integer):TDrawLine;
    Procedure DeleteSelected;
    Function ScreenPoint(P:TPoint):TFloatPoint;

    class Function Description:String; override;
    property Selected:TDrawLine read ISelected write SetSelected;
  published
    property Active;
    property Button:TMouseButton read FButton write FButton default mbLeft;
    property EnableDraw:Boolean read FEnableDraw write FEnableDraw default True;
    property EnableSelect:Boolean read FEnableSelect write SetEnableSelect default True;
    property Lines:TDrawLines read FLines write SetLines;
    property Pen;
    property Series;
    { events }
    property OnDraggedLine:TNotifyEvent read FOnDraggedLine write FOnDraggedLine; { 5.01 }
    property OnDragLine:TNotifyEvent read FOnDragLine write FOnDragLine;
    property OnNewLine:TNotifyEvent read FOnNewLine write FOnNewLine;
    property OnSelect:TNotifyEvent read FOnSelect write FOnSelect;
    property OnSelecting:TDrawLineSelecting read FOnSelecting write FOnSelecting;  { 5.03 }
  end;

{ This variable can be used to set the default "DrawLine" class used by
  TDrawLineTool when creating new lines }
  TDrawLineClass=class of TDrawLine;

Var
  TeeDrawLineClass:TDrawLineClass=TDrawLine; { 5.02 }

type
  TMarkToolMouseAction = (mtmMove, mtmClick);

  TMarksTipTool=class;

  TMarksTipGetText=procedure(Sender:TMarksTipTool; Var Text:String) of object;

  // Marks tip tool, use it to display "tips" or "hints" when the end-user
  // moves or clicks the mouse over a series point.
  TMarksTipTool=class(TTeeCustomToolSeries)
  private
    FMouseAction : TMarkToolMouseAction;
    FOnGetText   : TMarksTipGetText;
    FStyle       : TSeriesMarksStyle;

    Procedure SetMouseAction(Value:TMarkToolMouseAction);
    function GetMouseDelay: Integer;
    procedure SetMouseDelay(const Value: Integer);
  protected
    Function Chart:TCustomChart;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class function GetEditorClass: String; override;
    Procedure SetActive(Value:Boolean); override;
  public
    Constructor Create(AOwner:TComponent); override;
    class Function Description:String; override;
  published
    property Active;
    property MouseAction:TMarkToolMouseAction read FMouseAction
                                               write SetMouseAction default mtmMove;
    property MouseDelay:Integer read GetMouseDelay
                                write SetMouseDelay default 500; { 5.02 }

    property Series;
    property Style:TSeriesMarksStyle read FStyle write FStyle default smsLabel;

    property OnGetText:TMarksTipGetText read FOnGetText write FOnGetText;
  end;

  TNearestToolStyle=(hsNone,hsCircle,hsRectangle,hsDiamond);

  // Nearest tool, use it to display a graphical signal when the mouse is
  // moving near a series point.
  TNearestTool=class(TTeeCustomToolSeries)
  private
    FFullRepaint: Boolean;
    FLinePen    : TChartPen;
    FSize       : Integer;
    FStyle      : TNearestToolStyle;
    FOnChange   : TNotifyEvent;

    IMouse      : TPoint;

    Function GetDrawLine:Boolean;
    procedure PaintHint;
    procedure SetDrawLine(const Value: Boolean);
    procedure SetLinePen(const Value: TChartPen);
    procedure SetSize(const Value: Integer);
    procedure SetStyle(const Value: TNearestToolStyle);
    function ZAxisCalc(const Value:Double):Integer;
  protected
    procedure ChartEvent(AEvent: TChartToolEvent); override;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class function GetEditorClass: String; override;
  public
    Point : Integer;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    class Function GetNearestPoint(Series:TChartSeries; X,Y:Integer):Integer; overload;
    class Function GetNearestPoint(Series:TChartSeries; X,Y:Integer; IncludeNulls:Boolean):Integer; overload;
    class Function Description:String; override;
  published
    property Active;
    property Brush;
    property DrawLine:Boolean read GetDrawLine write SetDrawLine default True;
    property FullRepaint:Boolean read FFullRepaint write FFullRepaint default True;
    property LinePen:TChartPen read FLinePen write SetLinePen;  // 7.0
    property Pen;
    property Series;
    property Size:Integer read FSize write SetSize default 20;
    property Style:TNearestToolStyle read FStyle write SetStyle default hsCircle;
    property OnChange:TNotifyEvent read FOnChange write FOnChange;
  end;

  TColorLineTool=class;

  // Color band tool, use it to display a coloured rectangle (band)
  // at the specified axis and position.
  TColorBandTool=class(TTeeCustomToolAxis)
  private
    FColor        : TColor;
    FCursor       : TCursor; // 7.0
    FDrawBehind   : Boolean;
    FDrawBehindAxes: Boolean;