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

TAChart: Add TPanDragTool.Directions to allow panning in specified directions only.

Browse Source 
* This finishes issue #16109

git-svn-id: trunk@24339 -
This commit is contained in:
ask 2010-04-01 11:03:30 +00:00
parent a4cc8f74aa
commit fff9fbf31a
1 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/tachart/tatools.pas
View File

@ -113,16 +113,27 @@ type
read FZoomFactor write FZoomFactor stored ZoomFactorIsStored;
end;
TPanDirection = (pdLeft, pdUp, pdRight, pdDown);
TPanDirectionSet = set of TPanDirection;
const
PAN_DIRECTIONS_ALL = [Low(TPanDirection) .. High(TPanDirection)];
type
{ TPanDragTool }
TPanDragTool = class(TChartTool)
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;
{ TReticuleTool }
@ -543,6 +554,7 @@ end;
constructor TPanDragTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDirections := PAN_DIRECTIONS_ALL;
end;
{ TPanDragTool }
@ -554,8 +566,15 @@ begin
end;
procedure TPanDragTool.MouseMove(APoint: TPoint);
var
d: TPoint;
begin
FChart.Pan(APoint - FOrigin);
d := APoint - FOrigin;
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);
FChart.Pan(d);
FOrigin := APoint;
end;