Add a measure tool to measure distance between different par

TeeChart for ActiveX, COM and ASP
Post Reply
PhilOutram
Newbie
Newbie
Posts: 17
Joined: Mon Jun 19, 2006 12:00 am
Location: Auckland

Add a measure tool to measure distance between different par

Post by PhilOutram » Tue Jul 22, 2008 8:50 pm

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.

Narcís
Site Admin
Site Admin
Posts: 14730
Joined: Mon Jun 09, 2003 4:00 am
Location: Banyoles, Catalonia
Contact:

Post by Narcís » Wed Jul 23, 2008 8:32 am

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.

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
Image Image Image Image Image Image
Instructions - How to post in this forum

PhilOutram
Newbie
Newbie
Posts: 17
Joined: Mon Jun 19, 2006 12:00 am
Location: Auckland

Post by PhilOutram » Thu Jul 24, 2008 8:34 am

Great, thanks Narcis

Post Reply