teetools.pas

BCB第三方组件

{**********************************************}
{   TeeChart Tools                             }
{   Copyright (c) 1999-2007 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, QExtCtrls,
     {$ELSE}
     Graphics, Controls, ExtCtrls,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     {$IFDEF CLR}
     Variants,
     {$ENDIF}
     TeCanvas, TeeProcs, TeEngine, Chart, TeeFilters;

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

type
  // Style of cursor tool
  TCursorToolStyle=( cssHorizontal,
                     cssVertical,
                     cssBoth,
                     cssScope,     // 8.0
                     cssScopeOnly  // 8.01
                     );

  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;

  TSnapStyle=(ssDefault, ssHorizontal, ssVertical);

  TScopeCursorStyle=(scsRectangle, scsCircle, scsDiamond, scsEmpty, scsCamera);

  // Cursor tool, use it to draw a draggable line (cursor)
  TCursorTool=class(TTeeCustomToolSeries)
  private
    FClick         : Integer;
    FFollowMouse   : Boolean;
    FHorizSize     : Integer;

    FOnChange      : TCursorToolChangeEvent;
    FOnGetAxisRect : TCursorToolGetAxisRect;
    FOnSnapChange  : TCursorToolChangeEvent;

    FScopeSize     : Integer;
    FScopeStyle    : TScopeCursorStyle;
    FSnap          : Boolean;
    FSnapStyle     : TSnapStyle;
    FStyle         : TCursorToolStyle;
    FUseChartRect  : Boolean;
    FUseSeriesZ    : Boolean;  // 7.0
    FVertSize      : Integer;

    IDragging      : TCursorClicked;
    IOldSnap       : Integer;

    Procedure CalcValuePositions(X,Y:Integer);
    procedure DoChange;
    Function GetAxisRect:TRect;
    Function InMouseRectangle(x,y:Integer; UseSize:Boolean=False):Boolean;
    function MouseRectangle(X,Y:Integer; UseSize:Boolean):TRect;
    Procedure SetHorizSize(const Value:Integer);
    Procedure SetScopeSize(const Value:Integer);
    Procedure SetScopeStyle(const Value:TScopeCursorStyle);
    Procedure SetStyle(Value:TCursorToolStyle);
    procedure SetUseChartRect(const Value: Boolean);
    procedure SetUseSeriesZ(const Value: Boolean);
    Procedure SetVertSize(const Value:Integer);
    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;
    procedure SetParentChart(const Value: TCustomAxisPanel); override;
  public
    Constructor Create(AOwner:TComponent); override;

    procedure Assign(Source:TPersistent); override;

    Function Clicked(x,y:Integer):TCursorClicked;
    class Function Description:String; override;
    class Function LongDescription:String; override; // 8.0
    Function NearestPoint(AStyle:TCursorToolStyle; out 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 ClickTolerance:Integer read FClick write FClick default TeeClickTolerance; // 7.05
    property FollowMouse:Boolean read FFollowMouse write FFollowMouse default False;
    property HorizSize:Integer read FHorizSize write SetHorizSize default 0; // 8.0
    property Pen;
    property Series;
    property ScopeSize:Integer read FScopeSize write SetScopeSize default 4; // 8.0
    property ScopeStyle:TScopeCursorStyle read FScopeStyle write SetScopeStyle default scsRectangle; // 8.0
    property Snap:Boolean read FSnap write FSnap default False;
    property SnapStyle:TSnapStyle read FSnapStyle write FSnapStyle default ssDefault;
    property Style:TCursorToolStyle read FStyle write SetStyle default cssBoth;
    property UseSeriesZ:Boolean read FUseSeriesZ write SetUseSeriesZ default False;
    property VertSize:Integer read FVertSize write SetVertSize default 0; // 8.0

    { events }
    property OnChange:TCursorToolChangeEvent read FOnChange write FOnChange;
    property OnSnapChange:TCursorToolChangeEvent read FOnSnapChange write FOnSnapChange;  // 7.0
  end;

  TDragMarksTool=class;

  TDragMarkEvent=procedure(Sender:TDragMarksTool; Index:Integer;
                           Button:TMouseButton; Shift: TShiftState;
                           X,Y: Integer) of object;

  // Drag Marks tool, use it to allow the end-user to drag series Marks
  TDragMarksTool=class(TTeeCustomToolSeries)
  private
    FOnDragged  : TDragMarkEvent;
    FOnDragging : TDragMarkEvent;

    IOldX   : Integer;
    IOldY   : Integer;
    Index   : Integer;
    ISeries : TChartSeries;
  protected
    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;
    class Function LongDescription:String; override;
  published
    property Active;
    property Series;

    property OnDraggedMark:TDragMarkEvent read FOnDragged write FOnDragged; // 8.0
    property OnDraggingMark:TDragMarkEvent read FOnDragging write FOnDragging; // 8.0
  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
    FHeadWidth     : Integer;
    FLength        : Integer;
    FPosition      : TAxisArrowToolPosition;
    FScrollPercent : Integer;
    FScrollInverted: Boolean;
    FSizePercent   : Integer;

    FOnClick       : TAxisArrowClickEvent;

    Function ClickedArrow(x,y:Integer):Integer;
    procedure SetHeadWidth(const Value: Integer);
    procedure SetLength(const Value: Integer);
    procedure SetPosition(const Value: TAxisArrowToolPosition);
    procedure SetSizePercent(const Value: 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
    Constructor Create(AOwner:TComponent); override;

    class Function Description:String; override;
    class Function LongDescription:String; override;
  published
    property Active;
    property Position:TAxisArrowToolPosition read FPosition write SetPosition default aaBoth;
    property Axis;
    property Brush;
    property HeadWidth:Integer read FHeadWidth write SetHeadWidth default 8;  // 7.05
    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;
    property SizePercent:Integer read FSizePercent write SetSizePercent default 50;   // 7.05

    { 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;
    class Function GetEditorClass:String; override;
  public
    class Function Description:String; override;
    class Function LongDescription:String; override;
  published
    property Active;
    property Axis;
    property ScrollInverted:Boolean read FScrollInverted write FScrollInverted default False;
  end;

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

  TDrawLineStyle=(dlLine,
                  dlHorizParallel,
                  dlVertParallel,
                  dlRectangle,
                  dlEllipse);

  TDrawLineTool=class;

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

    Function GetParent:TDrawLineTool;
    function GetPen:TChartPen;
    function GetX0: Double;
    function GetX1: Double;
    function GetY0: Double;
    function GetY1: Double;
    function IsPenStored: Boolean;
    procedure SetPen(const Value: TChartPen);
    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;

    {$IFNDEF CLR} // Delphi .Net does not allow constructors to call virtual constructors
    Constructor CreateXY(Collection:TCollection; Const X0,Y0,X1,Y1:Double);
    {$ENDIF}

    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override; { 5.01 }
    function Clicked(X,Y:Integer; AHandle:TDrawLineHandle; PixelsTolerance:Integer=0):Boolean; // 7.04
    Procedure DrawHandles;
    Function EndHandle:TRect;
    Function StartHandle:TRect;

    property Parent:TDrawLineTool read GetParent;
  published
    property Pen:TChartPen read GetPen write SetPen stored IsPenStored;  // 7.01
    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 AddLine(const X0,Y0,X1,Y1:Double):TDrawLine;
    Function Last:TDrawLine;
    property Line[Index:Integer]:TDrawLine read Get write Put; default;
  end;

  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;
    FClick        : Integer;
    FEnableDraw   : Boolean;
    FEnableSelect : Boolean;
    FLines        : TDrawLines;
    FSelectNew    : Boolean;
    FStyle        : TDrawLineStyle;

    FOnDraggedLine: TNotifyEvent;
    FOnDragLine   : TNotifyEvent;
    FOnNewLine    : TNotifyEvent;
    FOnSelect     : TNotifyEvent;
    FOnSelecting  : TDrawLineSelecting;

    IDrawing  : Boolean;
    IMoved    : Boolean;
    IPoint    : TPoint;
    ISelected : TDrawLine;
    Procedure DrawLine(Const StartPos,EndPos:TPoint; AStyle:TDrawLineStyle);
    Function InternalClicked(X,Y:Integer; AHandle:TDrawLineHandle; ClickTolerance:Integer):TDrawLine; overload;
    Function InternalClicked(X,Y:Integer; AHandle:TDrawLineHandle):TDrawLine; overload;
    Procedure RedrawLine(ALine:TDrawLine);
    Procedure SetEnableSelect(Value:Boolean);
    Procedure SetLines(Const Value:TDrawLines);
    Procedure SetSelected(Value: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;

    Procedure Assign(Source:TPersistent); override;

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

    class Function Description:String; override;
    class Function LongDescription:String; override;

    property Selected:TDrawLine read ISelected write SetSelected;
  published
    property Active;
    property Button:TMouseButton read FButton write FButton default mbLeft;
    property ClickTolerance:Integer read FClick write FClick default 0;
    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 SelectNewLines:Boolean read FSelectNew write FSelectNew default True; // 7.05
    property Pen;
    property Series;
    property Style:TDrawLineStyle read FStyle write FStyle default dlLine; // 8.0

    { 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;