Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Проверить, находится ли курсор на линии

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.