// Die foldende Routine prüft, ob sich ein Punkt innerhalb
// oder außerhalb einer Ellipse befindet. Im Beispiel wird
// getestet, ob sich die Maus über eine auf Form1 gezeichnete
// Ellipse bewegt oder nicht.
// Siehe dazu auch
Testen, ob sich ein Punkt in einem Polygon befindet

// Getestet mit D4 unter WinME

var 
  x1, x2, y1, y2, a, b, mx, my: Integer; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  canvas.ellipse(x1, y1, x2, y2); 
end; 
 
procedure TForm1.Vorbereitung; // immer bei Ellipsen-Änderung 
begin 
  a := round((x2 - x1) / 2); 
  b := round((y2 - y1) / 2); 
  mx := x1 + a; 
  my := y1 + b; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  // --- z.B. --- 
  x1 := 50; 
  y1 := 50; 
  x2 := 300; 
  y2 := 100; 
  Label1.caption := ''; 
  // ------------ 
  Vorbereitung; 
end; 
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; 
  X, Y: Integer); 
begin 
  if punktdrin(Point(X, Y)) then 
    Label1.caption := 'drin' 
  else 
    Label1.caption := 'draußen'; 
end; 
 
function TForm1.punktdrin(pk: TPoint): boolean; 
var 
  X, Y: Integer; 
  Z: Double; 
begin 
  X := pk.X - mx; 
  Y := pk.Y - my; 
  if (a = 0.0) or (b = 0.0) then 
    result := false 
  else 
  begin 
    Z := abs(sqrt(abs((1 - sqr(X) / sqr(a)) * sqr(b)))); 
    result := (Y >= -Z) and (Y <= Z) and (X >= -a) and (X <= a); 
  end; 
end;

 

// Falls man nur Kreise (als Sonderform der Ellipse) abprüfen will,
// kann man natürlich die eben beschriebene Routine ebenfalls
// benutzen, man kann aber den Code auch geringfügig vereinfachen:

var 
  x1, x2, y1, y2, mx, my, rd: Integer; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  canvas.ellipse(x1, y1, x2, y2); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  x1 := 50; 
  y1 := 50; 
  x2 := 150; 
  y2 := 150; 
  Label1.caption := ''; 
  Vorbereitung; 
end; 
 
procedure TForm1.Vorbereitung; // immer bei Ellipsen-Änderung 
begin 
  rd := round((x2 - x1) / 2); 
  mx := x1 + rd; 
  my := y1 + rd; 
end; 
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; 
  X, Y: Integer); 
begin 
  if sqr(mx - X) + sqr(my - Y) < sqr(rd) then 
    Label1.caption := 'drin' 
  else 
    Label1.caption := 'draußen'; 
end;
 


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke