Вопрос: Заданы координаты (на плоскости) вершин четырехугольника. Определить, является ли он: а) ромбом; б) параллелограммом; в) прямоугольником; г) квадратом.
Категория: школьный раздел
Ответы:
а) 
program p1;
var x1,y1,x2,y2,x3,y3,x4,y4,a,b,c,d:real;
function romb(a,b,c,d:real):bolean;
begin
if (a=b)and(b=c)and(c=d)then
 romb:=true;
end;
begin
write(x1,y1,x2,y2,x3,y3,x4,y4);
readln(x1,y1,x2,y2,x3,y3,x4,y4);
a:=sqrt(sqr(x2-x1)+sqr(y2-y1));
b:=sqrt(sqr(x3-x2)+sqr(y3-y2));
c:=sqrt(sqr(x4-x3)+sqr(y4-y3));
d:=sqrt(sqr(x1-x4)+sqr(y1-y4));
if romb(a,b,c,d) then
writeln('четырехугольник является ромбом');
else 
writeln('четырехугольник не является ромбомж');
end.

б) 
uses crt;
const t=0.00001;
procedure Sered(x1,y1,x2,y2:real;var xs,ys:real);
begin
xs:=(x1+x2)/2;
ys:=(y1+y2)/2;
end;
var x1,y1,x2,y2,x3,y3,x4,y4,sx1,sy1,sx2,sy2:real;
begin
clrscr;
writeln('Введите координаты вершин прямоугольника в порядке обхода:');
writeln('Вершина 1:');
write('x=');readln(x1);
write('y=');readln(y1);
writeln('Вершина 2:');
write('x=');readln(x2);
write('y=');readln(y2);
writeln('Вершина 3:');
write('x=');readln(x3);
write('y=');readln(y3);
writeln('Вершина 4:');
write('x=');readln(x4);
write('y=');readln(y4);
Sered(x1,y1,x3,y3,sx1,sy1);
writeln('Координаты середины диагонали 1-3:');
writeln(sx1:0:2,' ',sy1:0:2);
Sered(x2,y2,x4,y4,sx2,sy2);
writeln('Координаты середины диагонали 2-4:');
writeln(sx2:0:2,' ',sy2:0:2);
if(abs(sx1-sx2)<t)and(abs(sy1-sy2)<t)then write('Это параллелограмм')
else write('Это не параллелограмм');
readln
end.

в) 
Function Pryamoug(Ax,Ay,Bx,By,Cx,Cy,Dx,Dy : Integer) : Boolean;
  Function Leng(x1,y1,x2,y2 : Integer) : Real;
  Begin
    Leng:=Sqrt(sqr(x2-x1)+sqr(y2-y1));
  end;
Begin
   Pryamoug:=((Leng(Ax,Ay,Cx,Cy)=Lengt(Bx,By,Dx,Dy)) and 
              (Leng(Ax,Ay,Bx,By)=Lengt(Cx,Cy,Dx,Dy)) and
              (Leng(Ax,Ay,Dx,Dy)=Lengt(Bx,By,Cx,Cy)));
end;

г) 
program koord;
uses crt;
var
  x1,y1,x2,y2,x3,y3,x4,y4:integer;
begin
  clrscr;
  writeln('vvedite koordinati tochek kvadrata ABCD cherez enter( x, enter, y, enter, x, enter...)');
  writeln;
  readln(x1);
  readln(y1);
  readln(x2);
  readln(y2);
  readln(x3);
  readln(y3);
  readln(x4);
  readln(y4);
  if sqrt(sqr(x4-x2)+sqr(y4-y2))=sqrt(sqr(x3-x1)+sqr(y3-y1)) then
  writeln('da eto taki kvadrat')
  else
  writeln('net eto ne kvadrat');
  readln
end.

program n_14;
var x, x1,x2,x3,y,y1,y2,y3: integer;
a,b,c,d,e,f: real;
begin 
  writeln ('Введите координаты точек по порядку (A,B,C,D)');
  readln (x, x1,x2,x3,y,y1,y2,y3);
  a:=sqrt((x-x1)*(x-x1)+(y-y1)*(y-y1)); {Нахождение длинны стороны}
  b:=sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2));
  c:=sqrt((x2-x3)*(x2-x3)+(y2-y3)*(y2-y3));
  d:=sqrt((x3-x)*(x3-x)+(y3-y)*(y3-y));
  
  e:=sqrt((x-x2)*(x-x2)+(y-y2)*(y-y2)); {Нахождение диагонали четырёхугольника}
  f := sqrt((x1-x3)*(x1-x3)+(y1-y3)*(y1-y3));
  
  if (((a=b) and (b=c) and (c=d) and (d=a)) and (e<>f)) then writeln ('Ромб')
    else if (((a=c) and (b=d)) and (e<>f)) then writeln ('Параллелограмм')
    else if ((a=b) and (b=c) and (c=d) and (d=a)) then writeln ('Квадрат')
        else if ((a=c) and (b=d)) then writeln ('Прямоугольник')
            else write ('Четырёхугольник');    {Условие отбора}
  end.