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

TAChart: Add OnCalculateNewExtent event to all zoom/drag tools.

Browse Source
This commit is contained in:
wp_xyz 2024-12-25 18:48:27 +01:00
parent 6e0c2e0095
commit 6d84ad507a
1 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/tachart/tatools.pas
View File

@ -205,7 +205,7 @@ type
procedure OnTimer(ASender: TObject);
protected
procedure DoCalculateNewExtent(var ANewExtent: TDoubleRect);
procedure DoCalculateNewExtent(var ANewExtent: TDoubleRect); virtual;
procedure DoZoom(ANewExtent: TDoubleRect; AFull: Boolean);
function IsAnimating: Boolean; inline;
function IsProportional: Boolean; virtual;
@ -301,12 +301,16 @@ type
TZoomClickTool = class(TBasicZoomStepTool)
public
procedure MouseDown(APoint: TPoint); override;
published
property OnCalculateNewExtent;
end;
TZoomMouseWheelTool = class(TBasicZoomStepTool)
public
procedure MouseWheelDown(APoint: TPoint); override;
procedure MouseWheelUp(APoint: TPoint); override;
published
property OnCalculateNewExtent;
end;
TPanDirection = (pdLeft, pdUp, pdRight, pdDown);
@ -322,8 +326,12 @@ type
TBasicPanTool = class(TChartTool)
strict private
FLimitToExtent: TPanDirectionSet;
FOnCalculateNewExtent: TCalculateNewExtentEvent;
strict protected
procedure DoCalculateNewExtent(var ANewExtent: TDoubleRect); virtual;
procedure PanBy(AOffset: TPoint);
property OnCalculateNewExtent: TCalculateNewExtentEvent
read FOnCalculateNewExtent write FOnCalculateNewExtent;
public
constructor Create(AOwner: TComponent); override;
published
@ -355,6 +363,7 @@ type
property EscapeCancels;
property MinDragRadius: Cardinal
read FMinDragRadius write FMinDragRadius default 0;
property OnCalculateNewExtent;
end;
{ TPanClickTool }
@ -380,6 +389,7 @@ type
property ActiveCursor default crSizeAll;
property Interval: Cardinal read FInterval write FInterval default 0;
property Margins: TChartMargins read FMargins write FMargins;
property OnCalculateNewExtent;
end;
{ TPanMouseWheelTool }
@ -398,6 +408,7 @@ type
property Step: Cardinal read FStep write FStep default 10;
property WheelUpDirection: TPanDirection
read FWheelUpDirection write FWheelUpDirection default pdUp;
property OnCalculateNewExtent;
end;
TChartDistanceMode = (cdmXY, cdmOnlyX, cdmOnlyY);
@ -1652,6 +1663,12 @@ begin
ActiveCursor := crSizeAll;
end;
procedure TBasicPanTool.DoCalculateNewExtent(var ANewExtent: TDoubleRect);
begin
if Assigned(FOnCalculateNewExtent) then
FOnCalculateNewExtent(Self, ANewExtent);
end;
procedure TBasicPanTool.PanBy(AOffset: TPoint);
var
dd: TDoublePoint;
@ -1672,6 +1689,7 @@ begin
end;
ext.a += dd;
ext.b += dd;
DoCalculateNewExtent(ext);
FChart.LogicalExtent := ext;
end;