mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-12 08:19:33 +01:00
TAChart: Add TDataPointDistanceTool.Distance function and OnMeasure event
git-svn-id: trunk@38327 -
This commit is contained in:
parent
930060f1e2
commit
56687efcdf
@ -500,6 +500,11 @@ type
|
||||
property Size: Integer read FSize write FSize default -1;
|
||||
end;
|
||||
|
||||
TDataPointDistanceTool = class;
|
||||
|
||||
TDataPointDistanceToolMeasureEvent =
|
||||
procedure (ASender: TDataPointDistanceTool) of object;
|
||||
|
||||
TDataPointDistanceTool = class(TDataPointDrawTool)
|
||||
published
|
||||
type
|
||||
@ -508,6 +513,7 @@ type
|
||||
strict private
|
||||
FAnchors: array of TDataPointTool.TPointRef;
|
||||
FMeasureMode: TChartDistanceMode;
|
||||
FOnMeasure: TDataPointDistanceToolMeasureEvent;
|
||||
FOptions: TOptions;
|
||||
function GetPointEnd: TDataPointTool.TPointRef; inline;
|
||||
procedure SetOptions(AValue: TOptions);
|
||||
@ -520,6 +526,7 @@ type
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function Distance(AUnits: TChartUnits = cuGraph): Double;
|
||||
procedure KeyDown(APoint: TPoint); override;
|
||||
procedure KeyUp(APoint: TPoint); override;
|
||||
procedure MouseDown(APoint: TPoint); override;
|
||||
@ -535,6 +542,9 @@ type
|
||||
property MeasureMode: TChartDistanceMode
|
||||
read FMeasureMode write FMeasureMode default cdmXY;
|
||||
property Options: TOptions read FOptions write SetOptions default [];
|
||||
published
|
||||
property OnMeasure: TDataPointDistanceToolMeasureEvent
|
||||
read FOnMeasure write FOnMeasure;
|
||||
end;
|
||||
|
||||
TReticuleTool = class(TChartTool)
|
||||
@ -1736,6 +1746,40 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDataPointDistanceTool.Distance(AUnits: TChartUnits): Double;
|
||||
var
|
||||
p1, p2: TDoublePoint;
|
||||
begin
|
||||
p1 := PointStart.GraphPos;
|
||||
p2 := PointEnd.GraphPos;
|
||||
case AUnits of
|
||||
cuPercent: exit(0); // Not implemented.
|
||||
cuAxis: begin
|
||||
if PointStart.Series <> nil then
|
||||
with PointStart.Series do
|
||||
p1 := DoublePoint(GraphToAxisX(p1.X), GraphToAxisY(p1.Y));
|
||||
if PointEnd.Series <> nil then
|
||||
with PointEnd.Series do
|
||||
p2 := DoublePoint(GraphToAxisX(p2.X), GraphToAxisY(p2.Y));
|
||||
end;
|
||||
cuGraph: ;
|
||||
cuPixel: begin
|
||||
with FChart.GraphToImage(p1) do
|
||||
p1 := DoublePoint(X, Y);
|
||||
with FChart.GraphToImage(p2) do
|
||||
p2 := DoublePoint(X, Y);
|
||||
end;
|
||||
end;
|
||||
case MeasureMode of
|
||||
cdmOnlyX: Result := Abs(p1.X - p2.X);
|
||||
cdmOnlyY: Result := Abs(p1.Y - p2.Y);
|
||||
// The user is responsible for ensuring that both axes have
|
||||
// the same physical dimensions: the xy distance is not
|
||||
// meaningful, for example, if x is in days and y in Dollars.
|
||||
cdmXY: Result := Norm([p1.X - p2.X, p1.Y - p2.Y]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataPointDistanceTool.DoDraw;
|
||||
var
|
||||
p1, p2: TPoint;
|
||||
@ -1816,6 +1860,8 @@ end;
|
||||
procedure TDataPointDistanceTool.MouseUp(APoint: TPoint);
|
||||
begin
|
||||
MouseMove(APoint);
|
||||
if Assigned(OnMeasure) then
|
||||
OnMeasure(Self);
|
||||
Deactivate;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user