whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

27 Visitors Online


 
...check if the Cursor is on a line?
Autor: Johannes Steiner
[ Print tip ]  

Tip Rating (10):  
     




{
  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 benötigt
  nur mit 80387 oder höher 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;


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners