Определить, лежит ли точка внутри квадрата

const
  npol = 4;
type
  TPoint = record
    X,Y : real;
  end;
  
  myArr = array[0..npol-1] of TPoint;
  
  
function PtInRgn(TestPolygon : myArr; 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[npol-1].X) and
     (TestPolygon[0].Y = TestPolygon[npol-1].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 npol-1 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 := npol - 1;  {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}
var xa,ya,xb,yb,xc,yc,xd,yd,xm,ym:real;
  P : Tpoint;
  regpol : myarr;
begin
  write('Xa = ');readln(xa);
  write('Ya = ');readln(ya);
  write('Xc = ');readln(xc);
  write('Yc = ');readln(yc);
  xa := 1;  ya := 7;
  xc := 11; yc := 5;
  xm:=(xa+xc)/2;
  ym:=(ya+yc)/2;
  xb:=xm+ym-ya;
  yb:=ym-xm+xa;
  xd:=xm-ym+ya;
  yd:=ym+xm-xa;
//  writeln('Xb=',xb,' Yb=',yb);
//  writeln('Xd=',xd,' Yd=',yd);
 
  regpol[0].X := xa;
  regpol[1].X := xb;
  regpol[2].X := xc;
  regpol[3].X := xd;
 
  regpol[0].Y := ya;
  regpol[1].Y := yb;
  regpol[2].Y := yc;
  regpol[3].Y := yd;
 
 
  write('координаты точки X = ');readln(P.X);
  write('координаты точки Y = ');readln(P.Y);
 
  if PtInRgn(regpol, P) then WriteLn('Входит') else WriteLn('НЕ входит');
  
  
end.

uses crt;
type point=record
           x,y:real;
           end;
//функция принадлежности точки треугольнику
function prin_trg(a,b,c,t:point):boolean;
//функция удвоенной площади треугольника по координатам
function plosh(a,b,c:point):real;
begin
  plosh:=(a.x-c.x)*(b.y-c.y)-(b.x-c.x)*(a.y-c.y)
end;
var s1,s2,s3:real;
begin
s1:=plosh(t,a,b);//определяем площади 3х малых треугольников
s2:=plosh(t,b,c);
s3:=plosh(t,c,a);
//если произведения площадей попарно больше 0, то точка внутри
prin_trg:=(s1*s2>0) and (s2*s3>0)
end;
 
var a,b,c,d,z,v,vb,vd,t:point;
begin
writeln('Введите координаты первой вершины');
readln(a.x,a.y);
writeln('Введите координаты противоположной вершины');
readln(c.x,c.y);
writeln('Введите координаты точки');
readln(t.x,t.y);
//найдем координаты остальных вершин квадрата
z.x:=(a.x+c.x)/2;//координаты центра
z.y:=(a.y+c.y)/2;
v.x:=a.x-z.x;//вектор из центра к А
v.y:=a.y-z.y;
vb.x:=v.y; //вектор из центра к В
vb.y:=-v.x;
vd.x:=-v.y;//вектор из центра к D
vd.y:=v.x;
b.x:=z.x+vb.x;//координаты вершины В
b.y:=z.y+vb.y;
d.x:=z.x+vd.x;//координаты вершины D
d.y:=z.y+vd.y;
clrscr;
writeln('Координаты вершин квадрата');
writeln('A(',a.x:0:2,';',a.y:0:2,')');
writeln('B(',b.x:0:2,';',b.y:0:2,')');
writeln('C(',c.x:0:2,';',c.y:0:2,')');
writeln('D(',d.x:0:2,';',d.y:0:2,')');
writeln('Координаты точки');
writeln(t.x:0:2,';',t.y:0:2);
if prin_trg(a,b,c,t)or prin_trg(a,c,d,t)
then write('Точка принадлежит квадрату')
else write('Точка не принадлежит квадрату')
 
end.

  a.x := 1;  a.y := 7;
  c.x := 11; c.y := 5;
 
  t.x := 6;
  t.y := 6;

//если произведения площадей попарно больше или=0, то точка внутри
prin_trg:=(s1*s2>=0) and (s2*s3>=0)