Помогите соединить в одно целое. Есть 4 часа времени
Составить программу, которая использует модуль. В модуле разработать подпрограммы для работы с декартовой плоскостью: принадлежность точки прямой, отрезку, многоугольнику. И добавте, пожалуйста, принадлежность прямой
Код:
Program geom3;
Const _Eps: Real = 1e-3; {точность вычислений}
var x1,y1,x2,y2,x,y:real;
Function RealEq(Const a, b:Real):Boolean; {строгоравно}
begin
RealEq := Abs(a-b)<= _Eps
End; {RealEq}
Function RealMoreEq(Const a, b:Real):Boolean; {большеилиравно}
begin
RealMoreEq := a - b >= _Eps
End; {RealMoreEq}
Function EqPoint(x1,y1,x2,y2:real):Boolean;
{Совпадают ли две точки на плоскости}
begin
EqPoint:=RealEq(x1,x2)and RealEq(y1,y2)
end; {EqPoint}
Function AtOtres(x1,y1,x2,y2,x,y:real):Boolean;
{Проверка принадлежности точки P отрезку P1P2}
Begin
If EqPoint( x1,y1,x2,y2)
Then AtOtres:= EqPoint( x1,y1,x,y)
{точки P1 и P2 совпадают, результат определяется совпадением точек P1 и P}
Else
AtOtres := RealEq((x-x1)*(y2-y1)- (y-y1)*(x2-x1),0)and (RealMoreEq(x,x1)and
RealMoreEq( x2,x)Or RealMoreEq(x,x2)and RealMoreEq( x1,x))
end; {AtOtres}
begin {main}
writeln('Введитекоординатыточек: x1,y1,x2,y2,x,y');
readln( x1,y1,x2,y2,x,y);
if AtOtres(x1,y1,x2,y2,x,y)
then writeln('Да.')
else writeln('Нет.' );
end. {main}
program geom5;
Const n=9; {Количествоточек+1}
_Eps: Real=1e-4; {точность вычислений}
type b=record
x,y:real;
end;
myArray= array[1..n] of b;
var
input:text;
x,y:real;
i:integer;
a:myArray;
procedure zapmas;
begin
assign(input,'input.pas');
reset(input);
for i:=1 to n-1 do
read(input, a[i].x,a[i].y);
readln(input, x,y);
close(input);
end;
function RealLess(Const a, b: Real): Boolean; {строгоменьше}
begin
RealLess := b-a> _Eps
end; {RealLess}
function VektorMulti(ax,ay,bx,by:real): real;
{Векторноепроизведениевекторов}
...
end;
Function LinesCross(x1,y1,x2,y2,x3,y3,x4,y4:real): boolean;
{Пересекаютсялиотрезки?}
...
end;
function InsidePoint(a:myArray):Boolean;
{Проверка принадлежности точки многоугольнику}
var i,k,nom: integer;
maxx:real;
begin
k:=0;
maxx:=a[1].x;
nom:=1;
for i:=2 to n-1 do
if maxx < a[i].x then begin maxx:=a[i].x;nom:=i;end;
a[n].x:=a[1].x; a[n].y:=a[1].y;
for i:=1 to n-1 do
if LinesCross(a[i].x,a[i].y,a[i+1].x,a[i+1].y,x,y,a[nom].x+1,a[nom].y)
then k:=k+1;
if k mod 2 <> 0
then InsidePoint:= true
else InsidePoint:= false;
end;
begin {main}
zapMas;
if InsidePoint(a)
then writeln('Точка внутри многоугольника.')
else writeln('Точка вне многоугольнка.)
end.
|