{
Algorytm sprawdzający, czy punkt p należy do wielokąta W
Program pobrano ze strony www.algorytm.org
Opracował: Michał Knasiecki
Format zapisu danych wejściowych znajduje się w pliku "!FormatDanych.txt"
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,math;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  vertex=record                         //Współrzędne
        x,y:integer;
        end;
var
  Form1: TForm1;
  polygon:array[0..20] of vertex;       //Tablica wierzchołków wielokąta, max 20
  p:vertex;                             //Dany punkt - pierwszy koniec odcinka
  r:vertex;                             //Drugi koniec odcinka
  n:byte;                               //liczba wierzchołków wielokąta
  k:integer;
  tmp:vertex;
implementation

{$R *.DFM}
function przynaleznosc(x,y,z:vertex):boolean; //Ta procedura sprawdza, czy punkt z należy do odcinka |xy|
var det:byte;
begin
det:=x.x*y.y+y.x*z.y+z.x*x.y-z.x*y.y-x.x*z.y-y.x*x.y;
if det<>0 then result:=false else
begin
if (min(x.x,y.x)<=z.x)and(z.x<=max(x.x,y.x)) and (min(x.y,y.y)<=z.y)and(z.y<=max(x.y,y.y)) then
result:=true else
result:=false;
end;
end;

function det(x,y,z:vertex):integer; //Wyznacznik macierzy kwadratowej stopnia 3.
begin
result:=x.x*y.y+y.x*z.y+z.x*x.y-z.x*y.y-x.x*z.y-y.x*x.y;
end;

function sgn(a:integer):integer;
begin
   if a = 0 then result := 0
   else if a < 0 then result := -1
   else result := 1;
end;

function przecinanie(a,b:vertex):boolean; //Funkcja sprawdza czy odcinki |AB| i |PR| się przecinają
begin
result:=false;
if (przynaleznosc(p,r,a)=false)and(przynaleznosc(p,r,b)=false)  then
begin   //półprosta nie przecina odcinka |AB| w końcach
if (sgn(det(p,r,a)) <> sgn(det(p,r,b))) and
   (sgn(det(a,b,p)) <> sgn(det(a,b,r))) then result:=true else
result:=false;
end else //do półprostej należy przynajmniej jeden koniec odcinka |AB|
                begin
                if (przynaleznosc(p,r,a))and(przynaleznosc(p,r,b)) then
                begin
                if (sgn(det(p,r,polygon[(k-1+n) mod n])) = sgn(det(p,r,polygon[(k+2) mod n]))) and
                   (sgn(det(p,r,polygon[(k-1+n) mod n])) <> 0) then result:=false
                else result:=true;
                end else
                if (przynaleznosc(p,r,polygon[(k-1+n) mod n]))or(przynaleznosc(p,r,polygon[(k+2) mod n]))then
                        result:=false else
                        begin //półprosta zawiera tylko wierzchołek
                        if przynaleznosc(p,r,b) then
                                begin
                                tmp:=a;
                                result:=false;
                                end;
                        if przynaleznosc(p,r,a) then
                                begin
                                if (sgn(det(p,r,tmp)) = sgn (det(p,r,b))) and
                                   (sgn(det(p,r,tmp)) <> 0) then result:=false
                                else result:=true;
                                end;
                        end;
                end;
end;
function oblicz:boolean; //Funkcja zwraca True, gdy liczba przecięć jest nieparzysta
var
        l:byte; //liczba przecięć
        i:integer;
begin
l:=0;
for i:=0 to n-1 do //pętla po wszystkich wierzchołkach wielokąta
        begin
        k:=i;
        if przynaleznosc(polygon[i], polygon[(i+1)mod n], p)=true then
        begin
           result:=true;
           showmessage('Punkt nalezy do krawedzi wielokata');
           exit;
        end;
        if przecinanie(polygon[i],polygon[(i+1) mod n]) then inc(l);
        end;
if (l mod 2)=0 then result:=false else result:=true;
showmessage('Liczba przecięć: '+inttostr(l));
end;

procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
    j:integer;
    max_X:integer;
begin
if fileexists('dane.txt') then
begin
        assignfile(f,'dane.txt');
        reset(f);
        //Wczytywanie współrzędnych punktu
        readln(f,p.x);
        readln(f,p.y);
        j:=0;
        n:=0;
        max_X:=0;
        while not(eof(f)) do
                begin
                readln(f,polygon[j].x);
                if polygon[j].x>max_X then max_X:=polygon[j].x;
                readln(f,polygon[j].y);
                inc(j);
                end;
        n:=j;                
        closefile(f);
        //Wyznaczanie współrzędnych drugiego końca odcinka
        r.x:=max_X+1;
        r.y:=p.y;
        //Punkt r na pewno znajduje się poza wielokątem
        //Wypisywanie danych wejściowych
        memo1.lines.add('p=('+inttostr(p.x)+','+inttostr(p.y)+')');
        memo1.lines.add('r=('+inttostr(r.x)+','+inttostr(r.y)+')');
        for j:=0 to n-1 do
        memo1.lines.add('Wierzchołek #'+inttostr(j)+'=('+inttostr(polygon[j].x)+','+inttostr(polygon[j].y)+')');
        if oblicz=true then showmessage('Punkt p należy do zadanego wielokąta') else
        showmessage('Punkt p NIE należy do zadanego wielokąta') 
end else showmessage('Plik z danymi nie istnieje');
end;

end.