Находится ли точка внутри многоугольника
Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch
function PtInRgn(TestPolygon : array of TPoint; const P : TPoint): boolean;
var
ToTheLeftofPoint, ToTheRightofPoint : byte;
np : integer;
OpenPolygon : boolean;
XIntersection : real;
begin
ToTheLeftofPoint := 0;
ToTheRightofPoint := 0;
OpenPolygon := False;
{Prufen ob das Polygon geschlossen ist}
{tests if the polygon is closed}
if not ((TestPolygon[0].X = TestPolygon[High(TestPolygon)].X) and
(TestPolygon[0].Y = TestPolygon[High(TestPolygon)].Y)) then
OpenPolygon := True;
{Tests fur jedes Paar der Punkte, um zu sehen wenn die Seite zwischen
ihnen, die horizontale Linie schneidet, die TestPoint durchlauft}
{tests for each couple of points to see if the side between them
crosses the horizontal line going through TestPoint}
for np := 1 to High(TestPolygon) do
if ((TestPolygon[np - 1].Y <= P.Y) and
(TestPolygon[np].Y > P.Y)) or
((TestPolygon[np - 1].Y > P.Y) and
(TestPolygon[np].Y <= P.Y))
{Wenn es so ist} {if it does}
then
begin
{berechnet die x Koordinate des Schnitts}
{computes the x coordinate of the intersection}
XIntersection := TestPolygon[np - 1].X +
((TestPolygon[np].X - TestPolygon[np - 1].X) /
(TestPolygon[np].Y - TestPolygon[np - 1].Y)) * (P.Y - TestPolygon[np - 1].Y);
{Zahler entsprechend verringern}
{increments appropriate counter}
if XIntersection < P.X then Inc(ToTheLeftofPoint);
if XIntersection > P.X then Inc(ToTheRightofPoint);
end;
{Falls das Polygon offen ist, die letzte Seite testen}
{if the polygon is open, test for the last side}
if OpenPolygon then
begin
np := High(TestPolygon); {Thanks to William Boyd - 03/06/2001}
if ((TestPolygon[np].Y <= P.Y) and
(TestPolygon[0].Y > P.Y)) or
((TestPolygon[np].Y > P.Y) and
(TestPolygon[0].Y <= P.Y)) then
begin
XIntersection := TestPolygon[np].X +
((TestPolygon[0].X - TestPolygon[np].X) /
(TestPolygon[0].Y - TestPolygon[np].Y)) * (P.Y - TestPolygon[np].Y);
if XIntersection < P.X then Inc(ToTheLeftofPoint);
if XIntersection > P.X then Inc(ToTheRightofPoint);
end;
end;
if (ToTheLeftofPoint mod 2 = 1) and (ToTheRightofPoint mod 2 = 1) then Result := True
else
Result := False;
end; {PtInRgn}
|