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

TAChart: Add TZoomMouseWheelTool

Browse Source 
git-svn-id: trunk@32642 -
This commit is contained in:
ask 2011-10-03 05:22:23 +00:00
parent cca154e0aa
commit 6cce24d91d
2 changed files with 70 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/tachart/tagraph.pas
View File

@ -707,6 +707,9 @@ const
EV: array [Boolean] of TChartToolEventId = (
evidMouseWheelDown, evidMouseWheelUp);
begin
// These modifiers are added by mousewheel event, but not by mouse button
// and key events. Ignore them to avoid user confusion.
AShift -= [ssNum, ssCaps, ssScroll];
Result :=
GetToolset.Dispatch(Self, EV[AWheelDelta > 0], AShift, AMousePos) or
inherited DoMouseWheel(AShift, AWheelDelta, AMousePos);

88
components/tachart/tatools.pas
View File

@ -70,6 +70,8 @@ type
procedure MouseDown(APoint: TPoint); virtual;
procedure MouseMove(APoint: TPoint); virtual;
procedure MouseUp(APoint: TPoint); virtual;
procedure MouseWheelDown(APoint: TPoint); virtual;
procedure MouseWheelUp(APoint: TPoint); virtual;
procedure RestoreCursor;
procedure SetCursor;
procedure SetIndex(AValue: Integer); override;
@ -220,18 +222,17 @@ type
read FRatioLimit write FRatioLimit default zrlNone;
end;
{ TZoomClickTool }
TZoomClickTool = class(TBasicZoomTool)
TBasicZoomStepTool = class(TBasicZoomTool)
strict private
FFixedPoint: Boolean;
FZoomFactor: Double;
FZoomRatio: Double;
function ZoomFactorIsStored: boolean;
function ZoomRatioIsStored: boolean;
strict protected
procedure DoZoomStep(const APoint: TPoint; const AFactor: TDoublePoint);
public
constructor Create(AOwner: TComponent); override;
procedure MouseDown(APoint: TPoint); override;
published
property FixedPoint: Boolean read FFixedPoint write FFixedPoint default false;
property ZoomFactor: Double
@ -240,6 +241,17 @@ type
read FZoomRatio write FZoomRatio stored ZoomRatioIsStored;
end;
TZoomClickTool = class(TBasicZoomStepTool)
public
procedure MouseDown(APoint: TPoint); override;
end;
TZoomMouseWheelTool = class(TBasicZoomStepTool)
public
procedure MouseWheelDown(APoint: TPoint); override;
procedure MouseWheelUp(APoint: TPoint); override;
end;
TPanDirection = (pdLeft, pdUp, pdRight, pdDown);
TPanDirectionSet = set of TPanDirection;
@ -520,11 +532,13 @@ begin
if Toolset.FIsHandled then exit;
end;
case AEventId of
evidKeyDown : KeyDown (APoint);
evidKeyUp : KeyUp (APoint);
evidMouseDown: MouseDown(APoint);
evidMouseMove: MouseMove(APoint);
evidMouseUp : MouseUp (APoint);
evidKeyDown : KeyDown (APoint);
evidKeyUp : KeyUp (APoint);
evidMouseDown : MouseDown (APoint);
evidMouseMove : MouseMove (APoint);
evidMouseUp : MouseUp (APoint);
evidMouseWheelDown: MouseWheelDown(APoint);
evidMouseWheelUp : MouseWheelUp (APoint);
end;
ev := FEventsAfter[AEventId];
if Assigned(ev) then
@ -610,6 +624,16 @@ begin
Unused(APoint);
end;
procedure TChartTool.MouseWheelDown(APoint: TPoint);
begin
Unused(APoint);
end;
procedure TChartTool.MouseWheelUp(APoint: TPoint);
begin
Unused(APoint);
end;
procedure TChartTool.ReadState(Reader: TReader);
begin
inherited ReadState(Reader);
@ -1000,21 +1024,21 @@ begin
FChart.OnDrawReticule(FChart, bestS.Index, best.FIndex, best.FValue);
end;
{ TZoomClickTool }
{ TBasicZoomStepTool }
constructor TZoomClickTool.Create(AOwner: TComponent);
constructor TBasicZoomStepTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FZoomFactor := 1.0;
FZoomRatio := 1.0;
end;
procedure TZoomClickTool.MouseDown(APoint: TPoint);
procedure TBasicZoomStepTool.DoZoomStep(
const APoint: TPoint; const AFactor: TDoublePoint);
var
sz, center, ratio, zoom: TDoublePoint;
sz, center, ratio: TDoublePoint;
ext: TDoubleRect;
begin
if (ZoomFactor <= 0) or (ZoomRatio <= 0) then exit;
ext := FChart.LogicalExtent;
center := FChart.ImageToGraph(APoint);
sz := ext.b - ext.a;
@ -1022,23 +1046,44 @@ begin
ratio := (center - ext.a) / sz
else
ratio := DoublePoint(0.5, 0.5);
zoom := DoublePoint(ZoomFactor, ZoomFactor * ZoomRatio);
ext.a := center - sz * ratio / zoom;
ext.b := center + sz * (DoublePoint(1, 1) - ratio) / zoom;
ext.a := center - sz * ratio / AFactor;
ext.b := center + sz * (DoublePoint(1, 1) - ratio) / AFactor;
DoZoom(ext, false);
Handled;
end;
function TZoomClickTool.ZoomFactorIsStored: boolean;
function TBasicZoomStepTool.ZoomFactorIsStored: boolean;
begin
Result := FZoomFactor <> 1.0;
end;
function TZoomClickTool.ZoomRatioIsStored: boolean;
function TBasicZoomStepTool.ZoomRatioIsStored: boolean;
begin
Result := FZoomRatio <> 1.0;
end;
{ TZoomClickTool }
procedure TZoomClickTool.MouseDown(APoint: TPoint);
begin
if (ZoomFactor <= 0) or (ZoomRatio <= 0) then exit;
DoZoomStep(APoint, DoublePoint(ZoomFactor, ZoomFactor * ZoomRatio));
end;
{ TZoomMouseWheelTool }
procedure TZoomMouseWheelTool.MouseWheelDown(APoint: TPoint);
begin
if (ZoomFactor <= 0) or (ZoomRatio <= 0) then exit;
DoZoomStep(APoint, DoublePoint(ZoomFactor, ZoomFactor * ZoomRatio));
end;
procedure TZoomMouseWheelTool.MouseWheelUp(APoint: TPoint);
begin
if (ZoomFactor <= 0) or (ZoomRatio <= 0) then exit;
DoZoomStep(APoint, DoublePoint(1 / ZoomFactor, 1 / ZoomFactor / ZoomRatio));
end;
{ TBasicPanTool }
constructor TBasicPanTool.Create(AOwner: TComponent);
@ -1430,8 +1475,9 @@ initialization
ToolsClassRegistry := TStringList.Create;
OnInitBuiltinTools := @InitBuitlinTools;
RegisterChartToolClass(TZoomDragTool, 'Zoom drag');
RegisterChartToolClass(TZoomClickTool, 'Zoom click');
RegisterChartToolClass(TZoomDragTool, 'Zoom on drag');
RegisterChartToolClass(TZoomClickTool, 'Zoom on click');
RegisterChartToolClass(TZoomMouseWheelTool, 'Zoom on mouse wheel');
RegisterChartToolClass(TPanDragTool, 'Panning drag');
RegisterChartToolClass(TPanClickTool, 'Panning click');
RegisterChartToolClass(TReticuleTool, 'Reticule');