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

TAChart: Add TDataPointDistanceTool.Distance function and OnMeasure event

Browse Source 
git-svn-id: trunk@38327 -
This commit is contained in:
ask 2012-08-22 09:15:49 +00:00
parent 930060f1e2
commit 56687efcdf
1 changed files with 46 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
components/tachart/tatools.pas
View File

@ -500,6 +500,11 @@ type
property Size: Integer read FSize write FSize default -1; property Size: Integer read FSize write FSize default -1;
end; end;
TDataPointDistanceTool = class;
TDataPointDistanceToolMeasureEvent =
procedure (ASender: TDataPointDistanceTool) of object;
TDataPointDistanceTool = class(TDataPointDrawTool) TDataPointDistanceTool = class(TDataPointDrawTool)
published published
type type
@ -508,6 +513,7 @@ type
strict private strict private
FAnchors: array of TDataPointTool.TPointRef; FAnchors: array of TDataPointTool.TPointRef;
FMeasureMode: TChartDistanceMode; FMeasureMode: TChartDistanceMode;
FOnMeasure: TDataPointDistanceToolMeasureEvent;
FOptions: TOptions; FOptions: TOptions;
function GetPointEnd: TDataPointTool.TPointRef; inline; function GetPointEnd: TDataPointTool.TPointRef; inline;
procedure SetOptions(AValue: TOptions); procedure SetOptions(AValue: TOptions);
@ -520,6 +526,7 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function Distance(AUnits: TChartUnits = cuGraph): Double;
procedure KeyDown(APoint: TPoint); override; procedure KeyDown(APoint: TPoint); override;
procedure KeyUp(APoint: TPoint); override; procedure KeyUp(APoint: TPoint); override;
procedure MouseDown(APoint: TPoint); override; procedure MouseDown(APoint: TPoint); override;
@ -535,6 +542,9 @@ type
property MeasureMode: TChartDistanceMode property MeasureMode: TChartDistanceMode
read FMeasureMode write FMeasureMode default cdmXY; read FMeasureMode write FMeasureMode default cdmXY;
property Options: TOptions read FOptions write SetOptions default []; property Options: TOptions read FOptions write SetOptions default [];
published
property OnMeasure: TDataPointDistanceToolMeasureEvent
read FOnMeasure write FOnMeasure;
end; end;
TReticuleTool = class(TChartTool) TReticuleTool = class(TChartTool)
@ -1736,6 +1746,40 @@ begin
inherited; inherited;
end; 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; procedure TDataPointDistanceTool.DoDraw;
var var
p1, p2: TPoint; p1, p2: TPoint;
@ -1816,6 +1860,8 @@ end;
procedure TDataPointDistanceTool.MouseUp(APoint: TPoint); procedure TDataPointDistanceTool.MouseUp(APoint: TPoint);
begin begin
MouseMove(APoint); MouseMove(APoint);
if Assigned(OnMeasure) then
OnMeasure(Self);
Deactivate; Deactivate;
end; end;