Проверить, находится ли курсор на линии

Советы » Мышка и Курсор » Проверить, находится ли курсор на линии

{ 
  Check if a Point(X,Y) (e.g a Cursor) is on a Linie (x1,y1) ; (x2,y2) 
  d = line width (min. 1) 

  Testen, ob sich der Punkt(X,Y) (z.B der Maus-Cursor) auf der Linie x1,y1 nach x2,y2 befindet. 
  d = halbe Liniendicke (min 1) 
  durch direkte Programmierung der FPU wird die Unit Math nicht benotigt 
  nur mit 80387 oder hoher einsetzbar! 
}

 function

CursorOnLinie(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 if

(dy > -d) and

(dy < d) and

(dx > -d) and

(dx < len + d) then

Result := True else

Result := False; end

; procedure

TForm1.FormPaint(Sender: TObject); begin

Canvas.Pen.Width := 1; Canvas.MoveTo(0, 0); Canvas.LineTo(Width, Weight); end

; procedure

TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var

p: TPoint; begin

GetCursorPos(p); p := ScreenToClient(p); if

CursorOnLinie(p.x, p.y, 0, 0, Width, Height, 1) then

Caption := 'Mouse on line.' else

Caption := 'Mouse not on line.' end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com