Как определить, если MousePos касается линии? - PullRequest
Новая
       57

Как определить, если MousePos касается линии?

2 голосов
/ 14 июня 2011

Я не уверен, достаточно ли ясно это, чтобы описать проблему ...

У меня есть 2 разные точки, Start -> End, затем он формирует линию.событие MouseMove, если MousePos касается линий ..

то, что я делал, использовало PtInRect, но результаты для области прямоугольника, а не для линии.Есть ли какая-либо функция для использования или ручной работы.есть идеи?

1 Ответ

4 голосов
/ 14 июня 2011

Проверьте этот код (исходный код check if the Cursor is on a line?) из 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

Это эквивалентная функция PontInLine без использования сборки (напрямую). 

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;

http://www.swissdelphicenter.ch/screenshots/tip906.png

...