paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 15:36:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add TPanDragTool.EscapeCancels property

Browse Source 
git-svn-id: trunk@38866 -
This commit is contained in:
ask 2012-09-27 15:51:04 +00:00
parent 320655321d
commit 6020e3b6da
1 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/tachart/tatools.pas
View File

@ -302,6 +302,9 @@ type
strict private
FDirections: TPanDirectionSet;
FOrigin: TPoint;
FPrev: TPoint;
strict protected
procedure Cancel; override;
public
constructor Create(AOwner: TComponent); override;
procedure MouseDown(APoint: TPoint); override;
@ -311,6 +314,7 @@ type
property ActiveCursor default crSizeAll;
property Directions: TPanDirectionSet
read FDirections write FDirections default PAN_DIRECTIONS_ALL;
property EscapeCancels;
end;
{ TPanClickTool }
@ -1323,6 +1327,13 @@ end;
{ TPanDragTool }
procedure TPanDragTool.Cancel;
begin
if not IsActive then exit;
MouseMove(FOrigin);
Deactivate;
end;
constructor TPanDragTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -1333,6 +1344,7 @@ procedure TPanDragTool.MouseDown(APoint: TPoint);
begin
Activate;
FOrigin := APoint;
FPrev := APoint;
Handled;
end;
@ -1340,8 +1352,9 @@ procedure TPanDragTool.MouseMove(APoint: TPoint);
var
d: TPoint;
begin
d := FOrigin - APoint;
FOrigin := APoint;
if not IsActive then exit;
d := FPrev - APoint;
FPrev := 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);