Difference between revisions of "Geometry in Pascal/de"

From Free Pascal wiki
Jump to navigationJump to search
m (unify code style, translate heading)
 
(2 intermediate revisions by 2 users not shown)
Line 1: Line 1:
 
{{geometry in pascal}}
 
{{geometry in pascal}}
<br><br>
+
 
 
__TOC__
 
__TOC__
<br />
+
 
=Testen, ob ein Punkt in einem Polygon liegt=
+
== Testen, ob ein Punkt in einem Polygon liegt ==
<syntaxhighlight>
+
<syntaxhighlight lang="pascal">
 
//  Die Funktion gibt den Wert True zurück, wenn der Punkt x,y innerhalb eines Polygons liegt.
 
//  Die Funktion gibt den Wert True zurück, wenn der Punkt x,y innerhalb eines Polygons liegt.
 
//  Die Funktion gibt den Wert False zurück, wenn der Punkt x,y nicht in einem Polygon liegt.
 
//  Die Funktion gibt den Wert False zurück, wenn der Punkt x,y nicht in einem Polygon liegt.
Line 16: Line 16:
 
function IsPointInPolygon(AX, AY: Integer; APolygon: array of TPoint): Boolean;
 
function IsPointInPolygon(AX, AY: Integer; APolygon: array of TPoint): Boolean;
 
var
 
var
   xnew, ynew: Cardinal;
+
   xnew, ynew,
   xold,yold: Cardinal;
+
   xold, yold,
   x1,y1: Cardinal;
+
   x1, y1,
   x2,y2: Cardinal;
+
   x2, y2:     Cardinal;
 
   i, npoints: Integer;
 
   i, npoints: Integer;
   inside: Integer = 0;
+
   inside:     Integer = 0;
  
 
begin
 
begin
 
 
   Result := False;
 
   Result := False;
  
Line 34: Line 33:
 
   yold := APolygon[npoints-1].Y;
 
   yold := APolygon[npoints-1].Y;
  
   for i := 0 to npoints - 1 do
+
   for i := 0 to npoints - 1 do begin
  begin
 
 
     xnew := APolygon[i].X;
 
     xnew := APolygon[i].X;
 
     ynew := APolygon[i].Y;
 
     ynew := APolygon[i].Y;
  
     if (xnew > xold) then
+
     if (xnew > xold) then begin
    begin
+
       x1 := xold;
       x1:=xold;
+
       x2 := xnew;
       x2:=xnew;
+
       y1 := yold;
       y1:=yold;
+
       y2 := ynew;
       y2:=ynew;
+
     end else begin
     end
+
       x1 := xnew;
    else
+
       x2 := xold;
    begin
+
       y1 := ynew;
       x1:=xnew;
+
       y2 := yold;
       x2:=xold;
 
       y1:=ynew;
 
       y2:=yold;
 
 
     end;
 
     end;
  
     if (((xnew < AX) = (AX <= xold))         // Die Ecke ist am linken Ende "offen"
+
     if (((xnew < AX) = (AX <= xold)) and    // Die Ecke ist am linken Ende "offen"
      and ((AY-y1)*(x2-x1) < (y2-y1)*(AX-x1))) then
+
      ((AY - y1) * (x2 - x1) < (y2 - y1) * (AX - x1))) then
 
     begin
 
     begin
 
       inside := not inside;
 
       inside := not inside;
 
     end;
 
     end;
  
     xold:=xnew;
+
     xold := xnew;
     yold:=ynew;
+
     yold := ynew;
  
 
   end;
 
   end;
  
 
   Result := inside <> 0;
 
   Result := inside <> 0;
 
 
end;
 
end;
 
</syntaxhighlight>
 
</syntaxhighlight>
  
== See also ==
+
== Siehe auch ==
*[http://www.visibone.com/inpoly/ A Point about Polygons]
+
* [http://www.visibone.com/inpoly/ A Point about Polygons] (Englisch)
 
 
<br />
 
<br />
 

Latest revision as of 21:38, 22 August 2020

Deutsch (de) English (en) français (fr)

Testen, ob ein Punkt in einem Polygon liegt

//  Die Funktion gibt den Wert True zurück, wenn der Punkt x,y innerhalb eines Polygons liegt.
//  Die Funktion gibt den Wert False zurück, wenn der Punkt x,y nicht in einem Polygon liegt.
//
//  Der Original C-Code: http://www.visibone.com/inpoly/inpoly.c.txt
//
//  Übersetzng von C nach Pascal: Felipe Monteiro de Carvalho
//
//  Lizenz: Public Domain

function IsPointInPolygon(AX, AY: Integer; APolygon: array of TPoint): Boolean;
var
  xnew, ynew,
  xold, yold,
  x1, y1,
  x2, y2:     Cardinal;
  i, npoints: Integer;
  inside:     Integer = 0;

begin
  Result := False;

  npoints := Length(APolygon);

  if (npoints < 3) then Exit;

  xold := APolygon[npoints-1].X;
  yold := APolygon[npoints-1].Y;

  for i := 0 to npoints - 1 do begin
    xnew := APolygon[i].X;
    ynew := APolygon[i].Y;

    if (xnew > xold) then begin
      x1 := xold;
      x2 := xnew;
      y1 := yold;
      y2 := ynew;
    end else begin
      x1 := xnew;
      x2 := xold;
      y1 := ynew;
      y2 := yold;
    end;

    if (((xnew < AX) = (AX <= xold)) and    // Die Ecke ist am linken Ende "offen"
       ((AY - y1) * (x2 - x1) < (y2 - y1) * (AX - x1))) then
    begin
      inside := not inside;
    end;

    xold := xnew;
    yold := ynew;

  end;

  Result := inside <> 0;
end;

Siehe auch