Hi,
Has anyone used code to create a measuring tool that simply get's the graph distance along a line drawn on the graph by the user? Any suggestions for the easiest way to do this would be appreciated.
Many thanks,
Phill.
Add a measure tool to measure distance between different par
-
- Newbie
- Posts: 17
- Joined: Mon Jun 19, 2006 12:00 am
- Location: Auckland
-
- Site Admin
- Posts: 14730
- Joined: Mon Jun 09, 2003 4:00 am
- Location: Banyoles, Catalonia
- Contact:
Hi Phill,
I made a Delphi project doing something similar some time ago, below there's the code. The same should be able using TeeChart Pro ActiveX.
I made a Delphi project doing something similar some time ago, below there's the code. The same should be able using TeeChart Pro ActiveX.
Code: Select all
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, Math, StdCtrls;
type
TForm1 = class(TForm)
Chart1: TChart;
Label1: TLabel;
procedure Chart1AfterDraw(Sender: TObject);
procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
LineX0,LineY0,LineX1,LineY1,Margin: integer;
function PointOnLine(const P:TPoint; px, py, qx, qy, Tolerance:integer):bool;
function DistancePointLine(Point, LineStart, LineEnd:TPoint):double;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Chart1AfterDraw(Sender: TObject);
begin
LineX0:=100;
LineY0:=300;
LineX1:=500;
LineY1:=300;
Margin:=10;
Chart1.Canvas.Line(LineX0,LineY0,LineX1,LineY1);
Chart1.Canvas.Pen.Color:=clRed;
if not ((LineX0<>LineX1) and (LineY0<>LineY1)) then
begin
Chart1.Canvas.Brush.Style := bsClear;
Chart1.Canvas.RoundRect(LineX0-Margin,LineY1-Margin,LineX1+Margin,LineY1+Margin,Margin*2,Margin*2);
end
else
begin
Chart1.Canvas.Line(LineX0-Margin,LineY0-Margin,LineX1+Margin,LineY1-Margin);
Chart1.Canvas.Line(LineX0-Margin,LineY0+Margin,LineX1+Margin,LineY1+Margin);
Chart1.Canvas.Line(LineX0-Margin,LineY0-Margin,LineX0-Margin,LineY0+Margin);
Chart1.Canvas.Line(LineX1+Margin,LineY1-Margin,LineX1+Margin,LineY1+Margin);
end;
end;
function TForm1.PointOnLine(const P:TPoint; px, py, qx, qy, Tolerance:integer):bool;
var
Distance: double;
begin
//quick test if point is begin or endpoint
if (((P.X = px) and (P.Y=py)) or ((P.X = qx) and (P.Y=qy))) then
begin
Result:=True;
exit;
end;
// calculate the distance of a_Point in relation to the Line
Distance:=DistancePointLine(P, Point(px,py), Point(qx,qy));
if ((Distance < -Tolerance) or (Distance > Tolerance)) then
Result:=false
else
Result:=true;
end;
function TForm1.DistancePointLine(Point, LineStart, LineEnd:TPoint):double;
var
near_x, near_y, dx, dy, t: double;
begin
dx := LineEnd.X - LineStart.X;
dy := LineEnd.Y - LineStart.Y;
If ((dx = 0) And (dy = 0)) Then
begin
// It's a point not a line segment.
dx := Point.X - LineStart.X;
dy := Point.Y - LineStart.Y;
Result := Sqrt(dx * dx + dy * dy);
Exit;
end;
//Calculate the t that minimizes the distance.
t := ((Point.X - LineStart.X) * dx + (Point.Y - LineStart.Y) * dy) /
(dx * dx + dy * dy);
//See if this represents one of the segment's
//end points or a point in the middle.
if t < 0 Then
begin
dx := Point.X - LineStart.X;
dy := Point.Y - LineStart.Y;
end
else
if t > 1 Then
begin
dx := Point.X - LineEnd.X;
dy := Point.Y - LineEnd.Y;
end
else
begin
near_x := LineStart.X + t * dx;
near_y := LineStart.Y + t * dy;
dx := Point.X - near_x;
dy := Point.Y - near_y;
end;
Result := Sqrt(dx * dx + dy * dy);
end;
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if PointOnLine(Point(X,Y),LineX0,LineY0,LineX1,LineY1,Margin) then
label1.Caption:='PointOnLine!'
else
label1.Caption:='';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
label1.Caption:='';
Chart1.Title.Text.Clear;
end;
end.
Best Regards,
Narcís Calvet / Development & Support Steema Software Avinguda Montilivi 33, 17003 Girona, Catalonia Tel: 34 972 218 797 http://www.steema.com |
Instructions - How to post in this forum |
-
- Newbie
- Posts: 17
- Joined: Mon Jun 19, 2006 12:00 am
- Location: Auckland