mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-30 16:49:35 +02:00
TAChart: Add TPanClickTool.Interval property
git-svn-id: trunk@26957 -
This commit is contained in:
parent
d5bdf30c13
commit
640106b5ef
@ -22,7 +22,7 @@ interface
|
|||||||
{$H+}
|
{$H+}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, Controls, Types,
|
Classes, Controls, CustomTimer, Types,
|
||||||
TAGraph, TATypes;
|
TAGraph, TATypes;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -193,14 +193,21 @@ type
|
|||||||
|
|
||||||
TPanClickTool = class(TBasicPanTool)
|
TPanClickTool = class(TBasicPanTool)
|
||||||
private
|
private
|
||||||
|
FInterval: Cardinal;
|
||||||
FMargins: TChartMargins;
|
FMargins: TChartMargins;
|
||||||
|
FOffset: TPoint;
|
||||||
|
FTimer: TCustomTimer;
|
||||||
|
|
||||||
function GetOffset(APoint: TPoint): TPoint;
|
function GetOffset(APoint: TPoint): TPoint;
|
||||||
|
procedure OnTimer(ASender: TObject);
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure MouseDown(APoint: TPoint); override;
|
procedure MouseDown(APoint: TPoint); override;
|
||||||
|
procedure MouseMove(APoint: TPoint); override;
|
||||||
|
procedure MouseUp(APoint: TPoint); override;
|
||||||
published
|
published
|
||||||
|
property Interval: Cardinal read FInterval write FInterval default 0;
|
||||||
property Margins: TChartMargins read FMargins write FMargins;
|
property Margins: TChartMargins read FMargins write FMargins;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -386,14 +393,14 @@ begin
|
|||||||
Result := TChartToolClass(ToolsClassRegistry.Objects[ATag]).Create(AOwner);
|
Result := TChartToolClass(ToolsClassRegistry.Objects[ATag]).Create(AOwner);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TChartTool }
|
||||||
|
|
||||||
procedure TChartTool.Activate;
|
procedure TChartTool.Activate;
|
||||||
begin
|
begin
|
||||||
inherited Activate;
|
inherited Activate;
|
||||||
SetCursor;
|
SetCursor;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TChartTool }
|
|
||||||
|
|
||||||
procedure TChartTool.Assign(Source: TPersistent);
|
procedure TChartTool.Assign(Source: TPersistent);
|
||||||
begin
|
begin
|
||||||
if Source is TChartTool then
|
if Source is TChartTool then
|
||||||
@ -841,11 +848,15 @@ constructor TPanClickTool.Create(AOwner: TComponent);
|
|||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
FMargins := TChartMargins.Create(nil);
|
FMargins := TChartMargins.Create(nil);
|
||||||
|
FTimer := TCustomTimer.Create(nil);
|
||||||
|
FTimer.Enabled := false;
|
||||||
|
FTimer.OnTimer := @OnTimer;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TPanClickTool.Destroy;
|
destructor TPanClickTool.Destroy;
|
||||||
begin
|
begin
|
||||||
FreeAndNil(FMargins);
|
FreeAndNil(FMargins);
|
||||||
|
FreeAndNil(FTimer);
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -871,15 +882,40 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TPanClickTool.MouseDown(APoint: TPoint);
|
procedure TPanClickTool.MouseDown(APoint: TPoint);
|
||||||
var
|
|
||||||
d: TPoint;
|
|
||||||
begin
|
begin
|
||||||
d := GetOffset(APoint);
|
FOffset := GetOffset(APoint);
|
||||||
if d = Point(0, 0) then exit;
|
if FOffset = Point(0, 0) then exit;
|
||||||
PanBy(d);
|
PanBy(FOffset);
|
||||||
|
if Interval > 0 then begin
|
||||||
|
Activate;
|
||||||
|
FTimer.Interval := Interval;
|
||||||
|
FTimer.Enabled := true;
|
||||||
|
end;
|
||||||
Handled;
|
Handled;
|
||||||
end;
|
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;
|
||||||
|
|
||||||
{ TDataPointDragTool }
|
{ TDataPointDragTool }
|
||||||
|
|
||||||
constructor TDataPointDragTool.Create(AOwner: TComponent);
|
constructor TDataPointDragTool.Create(AOwner: TComponent);
|
||||||
|
Loading…
Reference in New Issue
Block a user