lazarus/components/tachart/tatools.pas

{

 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

Authors: Alexander Klenin

}

unit TATools;

interface

{$H+}

uses
  Classes, Controls, CustomTimer, Types,
  TAChartUtils, TAGraph, TATypes;

type

  TChartToolset = class;
  TChartTool = class;

  TChartToolMouseEvent = procedure (ATool: TChartTool; APoint: TPoint) of object;

  { TChartTool }

  TChartTool = class(TBasicChartTool)
  private
    FActiveCursor: TCursor;
    FEnabled: Boolean;
    FMouseEvents: array [0..5] of TChartToolMouseEvent;
    FShift: TShiftState;
    FToolset: TChartToolset;
    procedure SetActiveCursor(const AValue: TCursor);
    procedure SetToolset(const AValue: TChartToolset);
  private
    FOldCursor: TCursor;
    function GetMouseEvent(AIndex: Integer): TChartToolMouseEvent;
    procedure SetMouseEvent(AIndex: Integer; AValue: TChartToolMouseEvent);
  protected
    procedure ReadState(Reader: TReader); override;
    procedure SetParentComponent(AParent: TComponent); override;
  protected
    procedure Activate; override;
    procedure Deactivate; override;
    procedure Dispatch(
      AChart: TChart; AEventId: TChartToolEventId; APoint: TPoint); overload;
    function GetIndex: Integer; override;
    function IsActive: Boolean;
    procedure MouseDown(APoint: TPoint); virtual;
    procedure MouseMove(APoint: TPoint); virtual;
    procedure MouseUp(APoint: TPoint); virtual;
    procedure RestoreCursor;
    procedure SetCursor;
    procedure SetIndex(AValue: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    procedure Assign(Source: TPersistent); override;
    function GetParentComponent: TComponent; override;
    procedure Handled;
    function HasParent: Boolean; override;

    property ActiveCursor: TCursor
      read FActiveCursor write SetActiveCursor default crDefault;
    property Toolset: TChartToolset read FToolset write SetToolset;
  published
    property Enabled: Boolean read FEnabled write FEnabled default true;
    property Shift: TShiftState read FShift write FShift;
  published
    property OnAfterMouseDown: TChartToolMouseEvent
      index 0 read GetMouseEvent write SetMouseEvent;
    property OnAfterMouseMove: TChartToolMouseEvent
      index 1 read GetMouseEvent write SetMouseEvent;
    property OnAfterMouseUp: TChartToolMouseEvent
      index 2 read GetMouseEvent write SetMouseEvent;
    property OnBeforeMouseDown: TChartToolMouseEvent
      index 3 read GetMouseEvent write SetMouseEvent;
    property OnBeforeMouseMove: TChartToolMouseEvent
      index 4 read GetMouseEvent write SetMouseEvent;
    property OnBeforeMouseUp: TChartToolMouseEvent
      index 5 read GetMouseEvent write SetMouseEvent;
  end;

  TChartToolClass = class of TChartTool;

  TChartTools = class(TIndexedComponentList)
  end;

  { TChartToolset }

  TChartToolset = class(TBasicChartToolset)
  private
    FIsHandled: Boolean;
    FTools: TChartTools;
    function GetItem(AIndex: Integer): TChartTool;
  protected
    procedure SetName(const AValue: TComponentName); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  public
    function Dispatch(
      AChart: TChart; AEventId: TChartToolEventId;
      AShift: TShiftState; APoint: TPoint): Boolean; override;
    property Item[AIndex: Integer]: TChartTool read GetItem; default;
  published
    property Tools: TChartTools read FTools;
  end;

  TUserDefinedTool = class(TChartTool)
  end;

  { TBasicZoomTool }

  TBasicZoomTool = class(TChartTool)
  private
    FAnimationInterval: Cardinal;
    FAnimationSteps: Cardinal;
    FCurrentStep: Cardinal;
    FExtDst: TDoubleRect;
    FExtSrc: TDoubleRect;
    FFullZoom: Boolean;
    FTimer: TCustomTimer;

    procedure OnTimer(ASender: TObject);
  protected
    procedure DoZoom(const ANewExtent: TDoubleRect; AFull: Boolean);
    function IsAnimating: Boolean; inline;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AnimationInterval: Cardinal
      read FAnimationInterval write FAnimationInterval default 0;
    property AnimationSteps: Cardinal
      read FAnimationSteps write FAnimationSteps default 0;
  end;

  TZoomRatioLimit = (zrlNone, zrlProportional, zrlFixedX, zrlFixedY);

  { TZoomDragTool }

  TZoomDragTool = class(TBasicZoomTool)
  private
    FRatioLimit: TZoomRatioLimit;
    FSelectionRect: TRect;
    function GetProportional: Boolean;
    procedure SetProportional(AValue: Boolean);
  public
    procedure MouseDown(APoint: TPoint); override;
    procedure MouseMove(APoint: TPoint); override;
    procedure MouseUp(APoint: TPoint); override;
  published
    property Proportional: Boolean
      read GetProportional write SetProportional stored false default false;
      deprecated;
    property RatioLimit: TZoomRatioLimit
      read FRatioLimit write FRatioLimit default zrlNone;
  end;

  { TZoomClickTool }

  TZoomClickTool = class(TBasicZoomTool)
  private
    FFixedPoint: Boolean;
    FZoomFactor: Double;
    FZoomRatio: Double;
    function ZoomFactorIsStored: boolean;
    function ZoomRatioIsStored: boolean;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseDown(APoint: TPoint); override;
  published
    property FixedPoint: Boolean read FFixedPoint write FFixedPoint default false;
    property ZoomFactor: Double
      read FZoomFactor write FZoomFactor stored ZoomFactorIsStored;
    property ZoomRatio: Double
      read FZoomRatio write FZoomRatio stored ZoomRatioIsStored;
  end;

  TPanDirection = (pdLeft, pdUp, pdRight, pdDown);
  TPanDirectionSet = set of TPanDirection;

const
  PAN_DIRECTIONS_ALL = [Low(TPanDirection) .. High(TPanDirection)];

type

  { TBasicPanTool }

  TBasicPanTool = class(TChartTool)
  private
    FLimitToExtent: TPanDirectionSet;
  protected
    procedure PanBy(AOffset: TPoint);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ActiveCursor default crSizeAll;
    property LimitToExtent: TPanDirectionSet
      read FLimitToExtent write FLimitToExtent default [];
  end;

  { TPanDragTool }

  TPanDragTool = class(TBasicPanTool)
  private
    FDirections: TPanDirectionSet;
    FOrigin: TPoint;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseDown(APoint: TPoint); override;
    procedure MouseMove(APoint: TPoint); override;
    procedure MouseUp(APoint: TPoint); override;
  published
    property Directions: TPanDirectionSet
      read FDirections write FDirections default PAN_DIRECTIONS_ALL;
  end;

  { TPanClickTool }

  TPanClickTool = class(TBasicPanTool)
  private
    FInterval: Cardinal;
    FMargins: TChartMargins;
    FOffset: TPoint;
    FTimer: TCustomTimer;

    function GetOffset(APoint: TPoint): TPoint;
    procedure OnTimer(ASender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MouseDown(APoint: TPoint); override;
    procedure MouseMove(APoint: TPoint); override;
    procedure MouseUp(APoint: TPoint); override;
  published
    property Interval: Cardinal read FInterval write FInterval default 0;
    property Margins: TChartMargins read FMargins write FMargins;
  end;

const
  DEF_GRAB_RADIUS = 4;

type
  { TDataPointTool }

  TDataPointTool = class(TChartTool)
  private
    FAffectedSeries: String;
    FGrabRadius: Integer;
    FPointIndex: Integer;
    FSeries: TBasicChartSeries;
    function ParseAffectedSeries: TBooleanDynArray;
  protected
    procedure FindNearestPoint(APoint: TPoint);
  public
    constructor Create(AOwner: TComponent); override;
  public
    property PointIndex: Integer read FPointIndex;
    property Series: TBasicChartSeries read FSeries;
  published
    property AffectedSeries: String
      read FAffectedSeries write FAffectedSeries;
    property GrabRadius: Integer
      read FGrabRadius write FGrabRadius default DEF_GRAB_RADIUS;
  end;

  { TDataPointDragTool }

  TDataPointDragTool = class(TDataPointTool)
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseDown(APoint: TPoint); override;
    procedure MouseMove(APoint: TPoint); override;
    procedure MouseUp(APoint: TPoint); override;
  published
    property ActiveCursor default crSizeAll;
  end;

  { TDataPointClickTool }

  TDataPointClickTool = class(TDataPointTool)
  private
    FMouseDownPoint: TPoint;
    FOnPointClick: TChartToolMouseEvent;
  public
    procedure MouseDown(APoint: TPoint); override;
    procedure MouseUp(APoint: TPoint); override;
  published
    property ActiveCursor;
    property OnPointClick: TChartToolMouseEvent
      read FOnPointClick write FOnPointClick;
  end;

  TDataPointHintTool = class;

  TChartToolHintEvent = procedure (
    ATool: TDataPointHintTool; const APoint: TPoint; var AHint: String) of object;

  { TDataPointHintTool }

  TDataPointHintTool = class(TDataPointTool)
  strict private
    FOnHint: TChartToolHintEvent;
    FPrevPointIndex: Integer;
    FPrevSeries: TBasicChartSeries;
    FUseDefaultHintText: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseMove(APoint: TPoint); override;
  published
    property ActiveCursor;
    property OnHint: TChartToolHintEvent read FOnHint write FOnHint;
    property UseDefaultHintText: Boolean
      read FUseDefaultHintText write FUseDefaultHintText default true;
  end;

  { TReticuleTool }

  TReticuleTool = class(TChartTool)
  public
    procedure MouseMove(APoint: TPoint); override;
  end;

  procedure Register;
  procedure RegisterChartToolClass(
    AToolClass: TChartToolClass; const ACaption: String);

resourcestring
  tasToolsEditorTitle = 'Edit tools';

implementation

uses
  ComponentEditors, Forms, GraphMath, Math, PropEdits, SysUtils,
  TACustomSeries, TADrawerCanvas, TAGeometry, TASubcomponentsEditor;

type
  { TToolsComponentEditor }

  TToolsComponentEditor = class(TSubComponentListEditor)
  protected
    function MakeEditorForm: TForm; override;
  public
    function GetVerb(Index: Integer): string; override;
  end;

  { TToolsPropertyEditor }

  TToolsPropertyEditor = class(TComponentListPropertyEditor)
  protected
    function GetChildrenCount: Integer; override;
    function MakeEditorForm: TForm; override;
  end;

  { TToolsEditorForm }

  TToolsEditorForm = class(TComponentListEditorForm)
  protected
    procedure AddSubcomponent(AParent, AChild: TComponent); override;
    procedure BuildCaption; override;
    function ChildClass: TComponentClass; override;
    procedure EnumerateSubcomponentClasses; override;
    function GetChildrenList: TFPList; override;
    function MakeSubcomponent(
      AOwner: TComponent; ATag: Integer): TComponent; override;
  end;

var
  ToolsClassRegistry: TStringList;

function InitBuitlinTools(AChart: TChart): TBasicChartToolset;
var
  ts: TChartToolset;
begin
  ts := TChartToolset.Create(AChart);
  Result := ts;
  with TZoomDragTool.Create(AChart) do begin
    Shift := [ssLeft];
    Toolset := ts;
  end;
  TReticuleTool.Create(AChart).Toolset := ts;
end;

procedure Register;
var
  i: Integer;
begin
  for i := 0 to ToolsClassRegistry.Count - 1 do
    RegisterNoIcon([TChartToolClass(ToolsClassRegistry.Objects[i])]);
  RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TChartToolset]);
  RegisterPropertyEditor(
    TypeInfo(TChartTools), TChartToolset, 'Tools', TToolsPropertyEditor);
  RegisterComponentEditor(TChartToolset, TToolsComponentEditor);
  RegisterPropertyEditor(
    TypeInfo(Boolean), TZoomDragTool, 'Proportional', THiddenPropertyEditor);
end;

procedure RegisterChartToolClass(
  AToolClass: TChartToolClass; const ACaption: String);
begin
  RegisterClass(AToolClass);
  ToolsClassRegistry.AddObject(ACaption, TObject(AToolClass));
end;

{ TToolsComponentEditor }

function TToolsComponentEditor.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := tasToolsEditorTitle
  else
    Result := '';
end;

function TToolsComponentEditor.MakeEditorForm: TForm;
begin
  Result := TToolsEditorForm.Create(Application, GetComponent, Self, nil);
end;

{ TToolsPropertyEditor }

function TToolsPropertyEditor.GetChildrenCount: Integer;
begin
  Result := (GetObjectValue as TChartTools).Count;
end;

function TToolsPropertyEditor.MakeEditorForm: TForm;
begin
  with TToolsEditorForm do
    Result := Create(Application, GetComponent(0) as TComponent, nil, Self);
end;

{ TToolsEditorForm }

procedure TToolsEditorForm.AddSubcomponent(AParent, AChild: TComponent);
begin
  (AChild as TChartTool).Toolset := (AParent as TChartToolset);
end;

procedure TToolsEditorForm.BuildCaption;
begin
  Caption := tasToolsEditorTitle + ' - ' + Parent.Name;
end;

function TToolsEditorForm.ChildClass: TComponentClass;
begin
  Result := TChartTool;
end;

procedure TToolsEditorForm.EnumerateSubcomponentClasses;
var
  i: Integer;
begin
  for i := 0 to ToolsClassRegistry.Count - 1 do
    AddSubcomponentClass(ToolsClassRegistry[i], i);
end;

function TToolsEditorForm.GetChildrenList: TFPList;
begin
  Result := (Parent as TChartToolset).Tools;
end;

function TToolsEditorForm.MakeSubcomponent(
  AOwner: TComponent; ATag: Integer): TComponent;
begin
  Result := TChartToolClass(ToolsClassRegistry.Objects[ATag]).Create(AOwner);
end;

{ TChartTool }

procedure TChartTool.Activate;
begin
  inherited Activate;
  SetCursor;
end;

procedure TChartTool.Assign(Source: TPersistent);
begin
  if Source is TChartTool then
    with TChartTool(Source) do begin
      Self.FEnabled := Enabled;
      Self.FShift := Shift;
    end
  else
    inherited Assign(Source);
end;

constructor TChartTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := true;
  FActiveCursor := crDefault;
end;

procedure TChartTool.Deactivate;
begin
  RestoreCursor;
  inherited Deactivate;
end;

destructor TChartTool.Destroy;
begin
  Toolset := nil;
  inherited;
end;

procedure TChartTool.Dispatch(
  AChart: TChart; AEventId: TChartToolEventId; APoint: TPoint);
var
  ev: TChartToolMouseEvent;
begin
  if not Enabled or (FChart <> nil) and (FChart <> AChart) then exit;
  FChart := AChart;
  ev := FMouseEvents[Ord(AEventId) + Ord(High(AEventId)) + 1];
  if Assigned(ev) then begin
    ev(Self, APoint);
    if Toolset.FIsHandled then exit;
  end;
  case AEventId of
    evidMouseDown: MouseDown(APoint);
    evidMouseMove: MouseMove(APoint);
    evidMouseUp  : MouseUp  (APoint);
  end;
  ev := FMouseEvents[Ord(AEventId)];
  if Assigned(ev) then
    ev(Self, APoint);
end;

function TChartTool.GetIndex: Integer;
begin
  if Toolset = nil then
    Result := -1
  else
    Result := Toolset.Tools.IndexOf(Self);
end;

function TChartTool.GetMouseEvent(AIndex: Integer): TChartToolMouseEvent;
begin
  Result := FMouseEvents[AIndex];
end;

function TChartTool.GetParentComponent: TComponent;
begin
  Result := FToolset;
end;

procedure TChartTool.Handled;
begin
  Toolset.FIsHandled := true;
end;

function TChartTool.HasParent: Boolean;
begin
  Result := true;
end;

function TChartTool.IsActive: Boolean;
begin
  Result := (FChart <> nil) and (FChart.ActiveToolIndex = Index);
end;

procedure TChartTool.MouseDown(APoint: TPoint);
begin
  Unused(APoint);
end;

procedure TChartTool.MouseMove(APoint: TPoint);
begin
  Unused(APoint);
end;

procedure TChartTool.MouseUp(APoint: TPoint);
begin
  Unused(APoint);
end;

procedure TChartTool.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TChartToolset then
    Toolset := Reader.Parent as TChartToolset;
end;

procedure TChartTool.RestoreCursor;
begin
  if ActiveCursor = crDefault then exit;
  FChart.Cursor := FOldCursor;
end;

procedure TChartTool.SetActiveCursor(const AValue: TCursor);
begin
  if FActiveCursor = AValue then exit;
  if IsActive then
    RestoreCursor;
  FActiveCursor := AValue;
  if IsActive then
    SetCursor;
end;

procedure TChartTool.SetCursor;
begin
  if ActiveCursor = crDefault then exit;
  FOldCursor := FChart.Cursor;
  FChart.Cursor := ActiveCursor;
end;

procedure TChartTool.SetIndex(AValue: Integer);
begin
  Toolset.Tools.Move(Index, EnsureRange(AValue, 0, Toolset.Tools.Count - 1));
end;

procedure TChartTool.SetMouseEvent(
  AIndex: Integer; AValue: TChartToolMouseEvent);
begin
  FMouseEvents[AIndex] := AValue;
end;

procedure TChartTool.SetParentComponent(AParent: TComponent);
begin
  if not (csLoading in ComponentState) then
    Toolset := AParent as TChartToolset;
end;

procedure TChartTool.SetToolset(const AValue: TChartToolset);
begin
  if FToolset = AValue then exit;
  if FToolset <> nil then
    FToolset.FTools.Remove(Self);
  FToolset := AValue;
  if FToolset <> nil then
    FToolset.FTools.Add(Self);
end;

{ TChartToolset }

constructor TChartToolset.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTools := TChartTools.Create;
end;

destructor TChartToolset.Destroy;
begin
  while Tools.Count > 0 do
    Item[Tools.Count - 1].Free;
  FreeAndNil(FTools);
  inherited;
end;

function TChartToolset.Dispatch(
  AChart: TChart; AEventId: TChartToolEventId;
  AShift: TShiftState; APoint: TPoint): Boolean;
var
  candidates: array of TChartTool;
  candidateCount: Integer;

  procedure AddCandidate(AIndex: Integer);
  begin
    candidates[candidateCount] := Item[AIndex];
    candidateCount += 1;
  end;

var
  i, ai: Integer;
begin
  if Tools.Count = 0 then exit(false);

  SetLength(candidates, Tools.Count);
  candidateCount := 0;

  ai := AChart.ActiveToolIndex;
  if InRange(ai, 0, Tools.Count - 1) then
    AddCandidate(ai);
  for i := 0 to Tools.Count - 1 do
    if (i <> ai) and (Item[i].Shift = AShift) then
      AddCandidate(i);

  FIsHandled := false;
  for i := 0 to candidateCount - 1 do begin
    candidates[i].Dispatch(AChart, AEventId, APoint);
    if FIsHandled then exit(true);
  end;
  Result := false;
end;

procedure TChartToolset.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i: Integer;
  t: TChartTool;
begin
  for i := 0 to Tools.Count - 1 do begin
    t := Item[i];
    if t.Owner = Root then
      Proc(t);
  end;
end;

function TChartToolset.GetItem(AIndex: Integer): TChartTool;
begin
  Result := TChartTool(Tools.Items[AIndex]);
end;

procedure TChartToolset.SetChildOrder(Child: TComponent; Order: Integer);
var
  i: Integer;
begin
  i := Tools.IndexOf(Child);
  if i >= 0 then
    Tools.Move(i, Order);
end;

procedure TChartToolset.SetName(const AValue: TComponentName);
var
  oldName: String;
begin
  if Name = AValue then exit;
  oldName := Name;
  inherited SetName(AValue);
  if csDesigning in ComponentState then
    Tools.ChangeNamePrefix(oldName, AValue);
end;

{ TBasicZoomTool }

constructor TBasicZoomTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TCustomTimer.Create(nil);
  FTimer.Enabled := false;
  FTimer.OnTimer := @OnTimer;
end;

destructor TBasicZoomTool.Destroy;
begin
  FreeAndNil(FTimer);
  inherited Destroy;
end;

procedure TBasicZoomTool.DoZoom(const ANewExtent: TDoubleRect; AFull: Boolean);
begin
  if (AnimationInterval = 0) or (AnimationSteps = 0) then begin
    if AFull then
      FChart.ZoomFull
    else
      FChart.LogicalExtent := ANewExtent;
    if IsActive then
      Deactivate;
    exit;
  end;
  if not IsActive then
    Activate;
  FExtSrc := FChart.LogicalExtent;
  FExtDst := ANewExtent;
  FFullZoom := AFull;
  FCurrentStep := 0;
  FTimer.Interval := AnimationInterval;
  FTimer.Enabled := true;
end;

function TBasicZoomTool.IsAnimating: Boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TBasicZoomTool.OnTimer(ASender: TObject);
var
  ext: TDoubleRect;
  t: Double;
  i: Integer;
begin
  Unused(ASender);
  FCurrentStep += 1;
  FTimer.Enabled := FCurrentStep < AnimationSteps;
  if FFullZoom and not IsAnimating then
    FChart.ZoomFull
  else begin
    t := FCurrentStep / AnimationSteps;
    for i := Low(ext.coords) to High(ext.coords) do
      ext.coords[i] := WeightedAverage(FExtSrc.coords[i], FExtDst.coords[i], t);
    NormalizeRect(ext);
    FChart.LogicalExtent := ext;
  end;
  if not IsAnimating then
    Deactivate;
end;

{ TZoomDragTool }

function TZoomDragTool.GetProportional: Boolean;
begin
  Result := RatioLimit = zrlProportional;
end;

procedure TZoomDragTool.MouseDown(APoint: TPoint);
begin
  if not FChart.AllowZoom then exit;
  Activate;
  with APoint do
    FSelectionRect := Rect(X, Y, X, Y);
  Handled;
end;

procedure TZoomDragTool.MouseMove(APoint: TPoint);
begin
  if not IsActive or IsAnimating then exit;
  PrepareXorPen(FChart.Canvas);
  FChart.Canvas.Rectangle(FSelectionRect);
  FSelectionRect.BottomRight := APoint;
  FChart.Canvas.Rectangle(FSelectionRect);
  Handled;
end;

procedure TZoomDragTool.MouseUp(APoint: TPoint);
var
  ext: TDoubleRect;

  procedure CheckProportions;
  var
    newSize, oldSize: TDoublePoint;
    coeff: Double;
  begin
    case RatioLimit of
      zrlNone: exit;
      zrlProportional: begin
        newSize := ext.b - ext.a;
        oldSize := FChart.LogicalExtent.b - FChart.LogicalExtent.a;
        coeff := newSize.Y * oldSize.X;
        if coeff = 0 then exit;
        coeff := newSize.X * oldSize.Y / coeff;
        if coeff = 0 then exit;
        if coeff > 1 then
          ExpandRange(ext.a.Y, ext.b.Y, (coeff - 1) / 2)
        else
          ExpandRange(ext.a.X, ext.b.X, (1 / coeff - 1) / 2);
      end;
      zrlFixedX:
        with FChart.GetFullExtent do begin
          ext.a.X := a.X;
          ext.b.X := b.X;
        end;
      zrlFixedY:
        with FChart.GetFullExtent do begin
          ext.a.Y := a.Y;
          ext.b.Y := b.Y;
        end;
    end;
  end;

begin
  Unused(APoint);

  PrepareXorPen(FChart.Canvas);
  FChart.Canvas.Rectangle(FSelectionRect);
  with FSelectionRect do begin
    if (Left >= Right) or (Top >= Bottom) then begin
      DoZoom(FChart.GetFullExtent, true);
      exit;
    end;
    ext.a := FChart.ImageToGraph(TopLeft);
    ext.b := FChart.ImageToGraph(BottomRight);
  end;
  NormalizeRect(ext);
  CheckProportions;
  DoZoom(ext, false);
  Handled;
end;

procedure TZoomDragTool.SetProportional(AValue: Boolean);
begin
  if AValue then
    RatioLimit := zrlProportional
  else
    RatioLimit := zrlNone;
end;

{ TReticuleTool }

procedure TReticuleTool.MouseMove(APoint: TPoint);
const
  DIST_FUNCS: array [TReticuleMode] of TPointDistFunc = (
    nil, @PointDistX, @PointDistY, @PointDist);
var
  cur, best: record
    pointIndex: Integer;
    retPos: TPoint;
    value: TDoublePoint;
  end;
  i, bestSeries: Integer;
  d, minDist: Double;
  df: TPointDistFunc;
begin
  if FChart.ReticuleMode = rmNone then exit;
  minDist := SafeInfinity;
  df := DIST_FUNCS[FChart.ReticuleMode];
  for i := 0 to FChart.SeriesCount - 1 do
    if
      (FChart.Series[i] is TCustomChartSeries) and
      (FChart.Series[i] as TCustomChartSeries).GetNearestPoint(
        df, APoint, cur.pointIndex, cur.retPos, cur.value) and
      PtInRect(FChart.ClipRect, cur.retPos)
    then begin
       d := df(APoint, cur.retPos);
       if d < minDist then begin
         bestSeries := i;
         best := cur;
         minDist := d;
       end;
    end;
  if not IsInfinite(minDist) and (best.retPos <> FChart.ReticulePos) then begin
    FChart.ReticulePos := best.retPos;
    if Assigned(FChart.OnDrawReticule) then
      FChart.OnDrawReticule(FChart, bestSeries, best.pointIndex, best.value);
  end;
end;

{ TZoomClickTool }

constructor TZoomClickTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FZoomFactor := 1.0;
  FZoomRatio := 1.0;
end;

procedure TZoomClickTool.MouseDown(APoint: TPoint);
var
  sz, center, ratio, zoom: TDoublePoint;
  ext: TDoubleRect;
begin
  if (ZoomFactor <= 0) or (ZoomRatio <= 0) then exit;
  ext := FChart.LogicalExtent;
  center := FChart.ImageToGraph(APoint);
  sz := ext.b - ext.a;
  if FixedPoint then
    ratio := (center - ext.a) / sz
  else
    ratio := DoublePoint(0.5, 0.5);
  zoom := DoublePoint(ZoomFactor, ZoomFactor * ZoomRatio);
  ext.a := center - sz * ratio / zoom;
  ext.b := center + sz * (DoublePoint(1, 1) - ratio) / zoom;
  DoZoom(ext, false);
  Handled;
end;

function TZoomClickTool.ZoomFactorIsStored: boolean;
begin
  Result := FZoomFactor <> 1.0;
end;

function TZoomClickTool.ZoomRatioIsStored: boolean;
begin
  Result := FZoomRatio <> 1.0;
end;

{ TBasicPanTool }

constructor TBasicPanTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveCursor := crSizeAll;
end;

procedure TBasicPanTool.PanBy(AOffset: TPoint);
var
  dd: TDoublePoint;
  ext, fullExt: TDoubleRect;
begin
  dd := FChart.ImageToGraph(AOffset) - FChart.ImageToGraph(Point(0, 0));
  ext := FChart.LogicalExtent;
  if LimitToExtent <> [] then begin
    fullExt := FChart.GetFullExtent;
    if (pdRight in LimitToExtent) and (ext.a.X + dd.X < fullExt.a.X) then
      dd.X := fullExt.a.X - ext.a.X;
    if (pdUp in LimitToExtent) and (ext.a.Y + dd.Y < fullExt.a.Y) then
      dd.Y := fullExt.a.Y - ext.a.Y;
    if (pdLeft in LimitToExtent) and (ext.b.X + dd.X > fullExt.b.X) then
      dd.X := fullExt.b.X - ext.b.X;
    if (pdDown in LimitToExtent) and (ext.b.Y + dd.Y > fullExt.b.Y) then
      dd.Y := fullExt.b.Y - ext.b.Y;
  end;
  ext.a += dd;
  ext.b += dd;
  FChart.LogicalExtent := ext;
end;

{ TPanDragTool }

constructor TPanDragTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDirections := PAN_DIRECTIONS_ALL;
end;

procedure TPanDragTool.MouseDown(APoint: TPoint);
begin
  Activate;
  FOrigin := APoint;
  Handled;
end;

procedure TPanDragTool.MouseMove(APoint: TPoint);
var
  d: TPoint;
begin
  d := FOrigin - APoint;
  FOrigin := APoint;

  if not (pdLeft in Directions) then d.X := Max(d.X, 0);
  if not (pdRight in Directions) then d.X := Min(d.X, 0);
  if not (pdUp in Directions) then d.Y := Max(d.Y, 0);
  if not (pdDown in Directions) then d.Y := Min(d.Y, 0);

  PanBy(d);
  Handled;
end;

procedure TPanDragTool.MouseUp(APoint: TPoint);
begin
  Unused(APoint);
  Deactivate;
  Handled;
end;

{ TPanClickTool }

constructor TPanClickTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMargins := TChartMargins.Create(nil);
  FTimer := TCustomTimer.Create(nil);
  FTimer.Enabled := false;
  FTimer.OnTimer := @OnTimer;
end;

destructor TPanClickTool.Destroy;
begin
  FreeAndNil(FMargins);
  FreeAndNil(FTimer);
  inherited Destroy;
end;

function TPanClickTool.GetOffset(APoint: TPoint): TPoint;
var
  r: TRect;
begin
  Result := Point(0, 0);
  r := FChart.ClipRect;
  if not PtInRect(r, APoint) then exit;
  with Size(r) do
    if
      (Margins.Left + Margins.Right >= cx) or
      (Margins.Top + Margins.Bottom >= cy)
    then
      exit;
  Result.X := Min(APoint.X - r.Left - Margins.Left, 0);
  if Result.X = 0 then
    Result.X := Max(Margins.Right - r.Right + APoint.X, 0);
  Result.Y := Min(APoint.Y - r.Top - Margins.Top, 0);
  if Result.Y = 0 then
    Result.Y := Max(Margins.Bottom - r.Bottom + APoint.Y, 0);
end;

procedure TPanClickTool.MouseDown(APoint: TPoint);
begin
  FOffset := GetOffset(APoint);
  if FOffset = Point(0, 0) then exit;
  PanBy(FOffset);
  if Interval > 0 then begin
    Activate;
    FTimer.Interval := Interval;
    FTimer.Enabled := true;
  end;
  Handled;
end;

procedure TPanClickTool.MouseMove(APoint: TPoint);
begin
  if not IsActive then exit;
  FOffset := GetOffset(APoint);
  FTimer.Enabled := FOffset <> Point(0, 0);
end;

procedure TPanClickTool.MouseUp(APoint: TPoint);
begin
  Unused(APoint);
  FTimer.Enabled := false;
  Deactivate;
  Handled;
end;

procedure TPanClickTool.OnTimer(ASender: TObject);
begin
  Unused(ASender);
  if FOffset <> Point(0, 0) then
    PanBy(FOffset);
end;

{ TDataPointTool }

constructor TDataPointTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGrabRadius := DEF_GRAB_RADIUS;
  FPointIndex := -1;
end;

procedure TDataPointTool.FindNearestPoint(APoint: TPoint);
var
  i, d, bestd, idx: Integer;
  bests: TBasicChartSeries;
  s: TCustomChartSeries;
  affected: TBooleanDynArray;
  dummy: TDoublePoint;
  nearest: TPoint;
begin
  bestd := MaxInt;
  bests := nil;
  affected := ParseAffectedSeries;
  for i := 0 to FChart.SeriesCount - 1 do begin
    if not affected[i] or not (FChart.Series[i] is TCustomChartSeries) then
      continue;
    s := FChart.Series[i] as TCustomChartSeries;
    if not s.GetNearestPoint(@PointDist, APoint, idx, nearest, dummy) then
      continue;
    d := PointDist(APoint, nearest);
    if d < bestd then begin
      bestd := d;
      bests := s;
      FPointIndex := idx;
    end;
  end;
  if (bests = nil) or (bestd > Sqr(GrabRadius)) then exit;
  FSeries := bests;
end;

function TDataPointTool.ParseAffectedSeries: TBooleanDynArray;
var
  s: TStringList;
  i, p: Integer;
begin
  SetLength(Result, FChart.SeriesCount);
  if AffectedSeries = '' then begin
    FillChar(Result[0], Length(Result), true);
    exit;
  end;
  s := TStringList.Create;
  try
    s.CommaText := AffectedSeries;
    FillChar(Result[0], Length(Result), false);
    for i := 0 to s.Count - 1 do begin
      p := StrToIntDef(s[i], -1);
      if InRange(p, 0, High(Result)) then
        Result[p] := true;
    end;
  finally
    s.Free;
  end;
end;

{ TDataPointDragTool }

constructor TDataPointDragTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveCursor := crSizeAll;
end;

procedure TDataPointDragTool.MouseDown(APoint: TPoint);
begin
  FindNearestPoint(APoint);
  if FSeries = nil then exit;
  Activate;
  Handled;
end;

procedure TDataPointDragTool.MouseMove(APoint: TPoint);
begin
  if FSeries <> nil then
    FSeries.MovePoint(FPointIndex, APoint);
end;

procedure TDataPointDragTool.MouseUp(APoint: TPoint);
begin
  Unused(APoint);
  FSeries := nil;
  Deactivate;
  Handled;
end;

{ TDataPointClickTool }

procedure TDataPointClickTool.MouseDown(APoint: TPoint);
begin
  FindNearestPoint(APoint);
  if FSeries = nil then exit;
  FMouseDownPoint := APoint;
  Activate;
  Handled;
end;

procedure TDataPointClickTool.MouseUp(APoint: TPoint);
begin
  if
    Assigned(OnPointClick) and (FSeries <> nil) and
    (PointDist(APoint, FMouseDownPoint) <= Sqr(GrabRadius))
  then
    OnPointClick(Self, FMouseDownPoint);
  FSeries := nil;
  Deactivate;
  Handled;
end;

{ TDataPointHintTool }

constructor TDataPointHintTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUseDefaultHintText := true;
end;

procedure TDataPointHintTool.MouseMove(APoint: TPoint);

  function GetHintText: String;
  begin
    if UseDefaultHintText then begin
      if Series is TChartSeries then
        Result := (Series as TChartSeries).FormattedMark(PointIndex)
      else
        Result := Format('%s: %d', [Series.Title, PointIndex]);
    end;
    if Assigned(OnHint) then
      OnHint(Self, APoint, Result);
  end;

begin
  FSeries := nil;
  FindNearestPoint(APoint);
  if Series = nil then begin
    FChart.ShowHint := false;
    Application.CancelHint;
    RestoreCursor;
    FPrevSeries := nil;
    exit;
  end;
  if (FPrevSeries = Series) and (FPrevPointIndex = PointIndex) then
    exit;
  if FPrevSeries = nil then
    SetCursor;
  FPrevSeries := Series;
  FPrevPointIndex := PointIndex;
  FChart.Hint := GetHintText;
  FChart.ShowHint := FChart.Hint <> '';
  if not FChart.ShowHint then exit;
  Application.HintPause := 0;
  Application.ActivateHint(FChart.ClientToScreen(APoint));
end;

initialization

  ToolsClassRegistry := TStringList.Create;
  OnInitBuiltinTools := @InitBuitlinTools;
  RegisterChartToolClass(TZoomDragTool, 'Zoom drag');
  RegisterChartToolClass(TZoomClickTool, 'Zoom click');
  RegisterChartToolClass(TPanDragTool, 'Panning drag');
  RegisterChartToolClass(TPanClickTool, 'Panning click');
  RegisterChartToolClass(TReticuleTool, 'Reticule');
  RegisterChartToolClass(TDataPointClickTool, 'Data point click');
  RegisterChartToolClass(TDataPointDragTool, 'Data point drag');
  RegisterChartToolClass(TDataPointHintTool, 'Data point hint');
  RegisterChartToolClass(TUserDefinedTool, 'User-defined');

finalization

  FreeAndNil(ToolsClassRegistry);

end.