mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-01 03:13:07 +02:00
TAChart: Add On{Before/After}Mouse{Down/Move/Up} events to chart tools. Update demo.
git-svn-id: trunk@25799 -
This commit is contained in:
parent
f60167a4e3
commit
1d35c4b3b3
@ -174,6 +174,7 @@ object Form1: TForm1
|
||||
end
|
||||
object ChartToolset1DataPointDragTool1: TDataPointDragTool
|
||||
Shift = [ssAlt, ssLeft]
|
||||
OnBeforeMouseMove = ChartToolset1DataPointDragTool1BeforeMouseMove
|
||||
AffectedSeries = '2,3'
|
||||
end
|
||||
end
|
||||
|
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, ExtCtrls, SysUtils, FileUtil, LResources, Forms, Controls,
|
||||
Graphics, Dialogs, TAGraph, TASeries, TASources, TATools;
|
||||
Graphics, Dialogs, Types, TAGraph, TASeries, TASources, TATools;
|
||||
|
||||
type
|
||||
|
||||
@ -33,6 +33,8 @@ type
|
||||
RandomChartSource1: TRandomChartSource;
|
||||
rgPan: TRadioGroup;
|
||||
procedure Chart1FuncSeries1Calculate(const AX: Double; out AY: Double);
|
||||
procedure ChartToolset1DataPointDragTool1BeforeMouseMove(ATool: TChartTool;
|
||||
APoint: TPoint);
|
||||
procedure rgPanClick(Sender: TObject);
|
||||
procedure rgZoomClick(Sender: TObject);
|
||||
end;
|
||||
@ -51,6 +53,22 @@ begin
|
||||
AY := Sin(AX * 10) + 0.7 * Cos(AX * 30) + 0.3 * Sin(AX * 80);
|
||||
end;
|
||||
|
||||
procedure TForm1.ChartToolset1DataPointDragTool1BeforeMouseMove(
|
||||
ATool: TChartTool; APoint: TPoint);
|
||||
const
|
||||
D = 10;
|
||||
begin
|
||||
with ATool as TDataPointDragTool do begin
|
||||
if
|
||||
(Series = ChartLine1) and
|
||||
(APoint.X > Chart1.XGraphToImage(ChartLine2.Position) - D) or
|
||||
(Series = ChartLine2) and
|
||||
(APoint.X < Chart1.XGraphToImage(ChartLine1.Position) + D)
|
||||
then
|
||||
Handled;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.rgPanClick(Sender: TObject);
|
||||
var
|
||||
b: Boolean;
|
||||
|
@ -28,6 +28,9 @@ uses
|
||||
type
|
||||
|
||||
TChartToolset = class;
|
||||
TChartTool = class;
|
||||
|
||||
TChartToolMouseEvent = procedure (ATool: TChartTool; APoint: TPoint) of object;
|
||||
|
||||
{ TChartTool }
|
||||
|
||||
@ -35,14 +38,17 @@ type
|
||||
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 RestoreCursor;
|
||||
procedure SetCursor;
|
||||
procedure SetMouseEvent(AIndex: Integer; AValue: TChartToolMouseEvent);
|
||||
protected
|
||||
procedure ReadState(Reader: TReader); override;
|
||||
procedure SetParentComponent(AParent: TComponent); override;
|
||||
@ -52,7 +58,6 @@ type
|
||||
procedure Dispatch(
|
||||
AChart: TChart; AEventId: TChartToolEventId; APoint: TPoint);
|
||||
function GetIndex: Integer; override;
|
||||
procedure Handled;
|
||||
function IsActive: Boolean;
|
||||
procedure MouseDown(APoint: TPoint); virtual;
|
||||
procedure MouseMove(APoint: TPoint); virtual;
|
||||
@ -64,6 +69,7 @@ type
|
||||
public
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function GetParentComponent: TComponent; override;
|
||||
procedure Handled;
|
||||
function HasParent: Boolean; override;
|
||||
|
||||
property ActiveCursor: TCursor
|
||||
@ -72,6 +78,19 @@ type
|
||||
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;
|
||||
@ -173,6 +192,7 @@ type
|
||||
procedure MouseUp(APoint: TPoint); override;
|
||||
public
|
||||
property PointIndex: Integer read FPointIndex;
|
||||
property Series: TBasicChartSeries read FSeries;
|
||||
published
|
||||
property ActiveCursor default crSizeAll;
|
||||
property AffectedSeries: String
|
||||
@ -374,15 +394,25 @@ 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;
|
||||
try
|
||||
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);
|
||||
finally
|
||||
if not IsActive then
|
||||
FChart := nil;
|
||||
@ -397,6 +427,11 @@ begin
|
||||
Result := Toolset.Tools.IndexOf(Self);
|
||||
end;
|
||||
|
||||
function TChartTool.GetMouseEvent(AIndex: Integer): TChartToolMouseEvent;
|
||||
begin
|
||||
Result := FMouseEvents[AIndex];
|
||||
end;
|
||||
|
||||
function TChartTool.GetParentComponent: TComponent;
|
||||
begin
|
||||
Result := FToolset;
|
||||
@ -467,6 +502,12 @@ 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
|
||||
|
Loading…
Reference in New Issue
Block a user