开发者

How to Determine if MousePos touches the Line?

开发者 https://www.devze.com 2023-03-12 12:01 出处:网络
Im not sure if this clear enough to describe the problem... I have 2 different points, S开发者_运维百科tart -> End then it forms a Line.

Im not sure if this clear enough to describe the problem...

I have 2 different points, S开发者_运维百科tart -> End then it forms a Line.

I would like to make an event on MouseMove if the MousePos touches the lines..

what i did was using the PtInRect but the results are for the rectangle area not the line. is there any function to use or manually made. any idea?


Check this code (original source check if the Cursor is on a line?) from torry's

type
  TForm73 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    x1,y1,x2,y2 : Integer;
  public
  end;

var
  Form73: TForm73;

implementation

{$R *.dfm}

function PontInLine(X, Y, x1, y1, x2, y2, d: Integer): Boolean;
var
  sine, cosinus: Double;
  dx, dy, len: Integer;
begin
  if d = 0 then d := 1;
  asm
    fild(y2)
    fisub(y1) // Y-Difference
    fild(x2)
    fisub(x1) // X-Difference
    fpatan    // Angle of the line in st(0)
    fsincos   // Cosinus in st(0), Sinus in st(1)
    fstp cosinus
    fstp sine
  end;
  dx  := Round(cosinus * (x - x1) + sine * (y - y1));
  dy  := Round(cosinus * (y - y1) - sine * (x - x1));
  len := Round(cosinus * (x2 - x1) + sine * (y2 - y1)); // length of line
  Result:= (dy > -d) and (dy < d) and (dx > -d) and (dx < len + d);
end;


procedure TForm73.Button1Click(Sender: TObject);
begin
  with Canvas do
  begin
    Pen.Color := clRed;
    MoveTo(x1,y1);
    LineTo(x2,y2);
  end;
end;

procedure TForm73.FormCreate(Sender: TObject);
begin
   x1:=10;
   y1:=100;
   x2:=200;
   y2:=150;
end;

procedure TForm73.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  p: TPoint;
begin
  GetCursorPos(p);
  p := ScreenToClient(p);
  if PontInLine(p.x, p.y, x1, y1, x2, y2, 1) then
    Caption := 'Mouse on line.'
  else
    Caption := 'Mouse not on line.'
end;

UPDATE

This is the equivalent function PontInLine without use assembly (directly).

uses
  Math;

function PontInLine(X, Y, x1, y1, x2, y2, d: Integer): Boolean;
var
  Theta,  sine, cosinus: Double;
  dx, dy, len: Integer;
begin
  if d = 0 then d := 1;
  //calc the angle of the line
  Theta:=ArcTan2( (y2-y1),(x2-x1));
  SinCos(Theta,sine, cosinus);
  dx  := Round(cosinus * (x - x1) + sine * (y - y1));
  dy  := Round(cosinus * (y - y1) - sine * (x - x1));
  len := Round(cosinus * (x2 - x1) + sine * (y2 - y1)); // length of line
  Result:= (dy > -d) and (dy < d) and (dx > -d) and (dx < len + d);
end;

How to Determine if MousePos touches the Line?


(source: swissdelphicenter.ch)

0

精彩评论

暂无评论...
验证码 换一张
取 消