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

TAChart: Add TPanMouseWheelTool

Browse Source 
git-svn-id: trunk@32658 -
This commit is contained in:
ask 2011-10-03 16:33:02 +00:00
parent 53b49c7086
commit d5499f7343
1 changed files with 57 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
components/tachart/tatools.pas
View File

@ -93,7 +93,7 @@ type
property Toolset: TChartToolset read FToolset write SetToolset; property Toolset: TChartToolset read FToolset write SetToolset;
published published
property Enabled: Boolean read FEnabled write FEnabled default true; property Enabled: Boolean read FEnabled write FEnabled default true;
property Shift: TShiftState read FShift write FShift; property Shift: TShiftState read FShift write FShift default [];
published published
property OnAfterKeyDown: TChartToolEvent property OnAfterKeyDown: TChartToolEvent
index 0 read GetAfterEvent write SetAfterEvent; index 0 read GetAfterEvent write SetAfterEvent;
@ -270,7 +270,6 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property ActiveCursor default crSizeAll;
property LimitToExtent: TPanDirectionSet property LimitToExtent: TPanDirectionSet
read FLimitToExtent write FLimitToExtent default []; read FLimitToExtent write FLimitToExtent default [];
end; end;
@ -278,7 +277,7 @@ type
{ TPanDragTool } { TPanDragTool }
TPanDragTool = class(TBasicPanTool) TPanDragTool = class(TBasicPanTool)
private strict private
FDirections: TPanDirectionSet; FDirections: TPanDirectionSet;
FOrigin: TPoint; FOrigin: TPoint;
public public
@ -287,6 +286,7 @@ type
procedure MouseMove(APoint: TPoint); override; procedure MouseMove(APoint: TPoint); override;
procedure MouseUp(APoint: TPoint); override; procedure MouseUp(APoint: TPoint); override;
published published
property ActiveCursor default crSizeAll;
property Directions: TPanDirectionSet property Directions: TPanDirectionSet
read FDirections write FDirections default PAN_DIRECTIONS_ALL; read FDirections write FDirections default PAN_DIRECTIONS_ALL;
end; end;
@ -309,10 +309,29 @@ type
procedure MouseMove(APoint: TPoint); override; procedure MouseMove(APoint: TPoint); override;
procedure MouseUp(APoint: TPoint); override; procedure MouseUp(APoint: TPoint); override;
published published
property ActiveCursor default crSizeAll;
property Interval: Cardinal read FInterval write FInterval default 0; 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;
{ TPanMouseWheelTool }
TPanMouseWheelTool = class(TBasicPanTool)
strict private
FStep: Cardinal;
FWheelUpDirection: TPanDirection;
procedure DoPan(AStep: Integer);
public
constructor Create(AOwner: TComponent); override;
procedure MouseWheelDown(APoint: TPoint); override;
procedure MouseWheelUp(APoint: TPoint); override;
published
property Step: Cardinal read FStep write FStep default 10;
property WheelUpDirection: TPanDirection
read FWheelUpDirection write FWheelUpDirection default pdUp;
end;
TChartDistanceMode = (cdmXY, cdmOnlyX, cdmOnlyY); TChartDistanceMode = (cdmXY, cdmOnlyX, cdmOnlyY);
{ TDataPointTool } { TDataPointTool }
@ -1227,6 +1246,35 @@ begin
PanBy(FOffset); PanBy(FOffset);
end; end;
{ TPanMouseWheelTool }
constructor TPanMouseWheelTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetPropDefaults(Self, ['Step', 'WheelUpDirection']);
end;
procedure TPanMouseWheelTool.DoPan(AStep: Integer);
const
DIR_TO_OFFSET: array [TPanDirection] of TPoint =
// pdLeft, pdUp, pdRight, pdDown
((X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1));
begin
PanBy(DIR_TO_OFFSET[WheelUpDirection] * AStep);
end;
procedure TPanMouseWheelTool.MouseWheelDown(APoint: TPoint);
begin
Unused(APoint);
DoPan(-Step);
end;
procedure TPanMouseWheelTool.MouseWheelUp(APoint: TPoint);
begin
Unused(APoint);
DoPan(Step);
end;
{ TDataPointTool } { TDataPointTool }
constructor TDataPointTool.Create(AOwner: TComponent); constructor TDataPointTool.Create(AOwner: TComponent);
@ -1475,11 +1523,12 @@ initialization
ToolsClassRegistry := TStringList.Create; ToolsClassRegistry := TStringList.Create;
OnInitBuiltinTools := @InitBuitlinTools; OnInitBuiltinTools := @InitBuitlinTools;
RegisterChartToolClass(TZoomDragTool, 'Zoom on drag'); RegisterChartToolClass(TZoomDragTool, 'Zoom by drag');
RegisterChartToolClass(TZoomClickTool, 'Zoom on click'); RegisterChartToolClass(TZoomClickTool, 'Zoom by click');
RegisterChartToolClass(TZoomMouseWheelTool, 'Zoom on mouse wheel'); RegisterChartToolClass(TZoomMouseWheelTool, 'Zoom by mouse wheel');
RegisterChartToolClass(TPanDragTool, 'Panning drag'); RegisterChartToolClass(TPanDragTool, 'Panning by drag');
RegisterChartToolClass(TPanClickTool, 'Panning click'); RegisterChartToolClass(TPanClickTool, 'Panning by click');
RegisterChartToolClass(TPanMouseWheelTool, 'Panning by mouse wheel');
RegisterChartToolClass(TReticuleTool, 'Reticule'); RegisterChartToolClass(TReticuleTool, 'Reticule');
RegisterChartToolClass(TDataPointClickTool, 'Data point click'); RegisterChartToolClass(TDataPointClickTool, 'Data point click');
RegisterChartToolClass(TDataPointDragTool, 'Data point drag'); RegisterChartToolClass(TDataPointDragTool, 'Data point drag');