Код
{Dano: Esli 4 tochki zadanie koordinatami na ploskosti, mogut bit vershinami romba,}
{nayiti koordinati tochki peresecheniya ego diagonaleyi}
Program Romb;
uses crt;
var
i:integer;
Xa,Xb,Xc,Xd,Xo,Ya,Yb,Yc,Yd,Yo,AB,BC,CD,DA:real;
mas:array[1..8] of real;
PROCEDURE Wind(x0,y0,l,h:word; fors,Bg:byte);
{Формирует окно с начальной координатой Х0 У0, цвет длина высота}
begin
window(x0,y0,x0+l-1,y0+h-1);
TextBackGround(Bg);
TextColor(fors);
clrscr;
end;
PROCEDURE Inp(x0,y0,l,h:word);
{Поцедура окно ввода координат и проверяет правильность ввода}
var
oldbg,oldo,code:word;
st:string;
begin
oldbg:=TextAttr div 16;
oldo:=TextAttr mod 16;
code:=1;
i:=i+1;
while code<>0 do
begin
wind(x0,y0,l,h,oldbg,oldo);
readln(st);
val(st,mas[i],code);
if code<>0 then
writeln(#7)
end;
wind(x0,y0,l,h,oldo,oldbg);
write(mas[i]:0:2);
end;
BEGIN
clrscr;
wind(3,2,76,7,black,red);
writeln(' vvedite koordinati vershin romba: ');
writeln(' Xa= Ya=');
writeln(' Xb= Yb=');
writeln(' Xc= Yc=');
writeln(' Xd= Yd=');
inp(7,3,15,1);
inp(26,3,15,1);
inp(7,4,15,1);
inp(26,4,15,1);
inp(7,5,15,1);
inp(26,5,15,1);
inp(7,6,15,1);
inp(26,6,15,1);
Xa:=mas[1]; Ya:=mas[2];
Xb:=mas[3]; Yb:=mas[4];
Xc:=mas[5]; Yc:=mas[6];
Xd:=mas[7]; Yd:=mas[8];
AB:=sqrt(sqr(Xb-Xa)+sqr(Yb-Ya));
BC:=sqrt(sqr(Xc-Xb)+sqr(Yc-Yb));
CD:=sqrt(sqr(Xc-Xd)+sqr(Yc-Yd));
DA:=sqrt(sqr(Xd-Xa)+sqr(Yd-Ya));
wind(3,10,76,5,white, black);
if (not ((AB=BC) and (BC=CD) and (CD=DA))) or
((Xb-Xa)*(Yc-Ya)=(Xc-Xa)*(Yb-Ya)) or
((Xb-Xa)*(Yd-Ya)=(Xd-Xa)*(Yb-Ya)) or
((Xc-Xb)*(Yd-Yb)=(Xd-Xb)*(Yc-Yb)) or
((Xd-Xc)*(Ya-Yc)=(Xa-Xc)*(Yd-Yc)) then
writeln(' romba s takimi koordinatami ne suschestvuet')
else
begin
writeln(' Koordinati peresecheniya dioganaley:');
writeln(' Xo= Yo=');
Xo:=(Xc-Xa)/2+Xa;
Yo:=(Yc-Ya)/2+Ya;
GoToXY(5,2);
write(Xo:2:2);
GoToXY(24,2);
write(Yo:2:2);
end;
GoToXY(5,5);
write('Press any key to exit');
repeat
until keypressed
END.
{nayiti koordinati tochki peresecheniya ego diagonaleyi}
Program Romb;
uses crt;
var
i:integer;
Xa,Xb,Xc,Xd,Xo,Ya,Yb,Yc,Yd,Yo,AB,BC,CD,DA:real;
mas:array[1..8] of real;
PROCEDURE Wind(x0,y0,l,h:word; fors,Bg:byte);
{Формирует окно с начальной координатой Х0 У0, цвет длина высота}
begin
window(x0,y0,x0+l-1,y0+h-1);
TextBackGround(Bg);
TextColor(fors);
clrscr;
end;
PROCEDURE Inp(x0,y0,l,h:word);
{Поцедура окно ввода координат и проверяет правильность ввода}
var
oldbg,oldo,code:word;
st:string;
begin
oldbg:=TextAttr div 16;
oldo:=TextAttr mod 16;
code:=1;
i:=i+1;
while code<>0 do
begin
wind(x0,y0,l,h,oldbg,oldo);
readln(st);
val(st,mas[i],code);
if code<>0 then
writeln(#7)
end;
wind(x0,y0,l,h,oldo,oldbg);
write(mas[i]:0:2);
end;
BEGIN
clrscr;
wind(3,2,76,7,black,red);
writeln(' vvedite koordinati vershin romba: ');
writeln(' Xa= Ya=');
writeln(' Xb= Yb=');
writeln(' Xc= Yc=');
writeln(' Xd= Yd=');
inp(7,3,15,1);
inp(26,3,15,1);
inp(7,4,15,1);
inp(26,4,15,1);
inp(7,5,15,1);
inp(26,5,15,1);
inp(7,6,15,1);
inp(26,6,15,1);
Xa:=mas[1]; Ya:=mas[2];
Xb:=mas[3]; Yb:=mas[4];
Xc:=mas[5]; Yc:=mas[6];
Xd:=mas[7]; Yd:=mas[8];
AB:=sqrt(sqr(Xb-Xa)+sqr(Yb-Ya));
BC:=sqrt(sqr(Xc-Xb)+sqr(Yc-Yb));
CD:=sqrt(sqr(Xc-Xd)+sqr(Yc-Yd));
DA:=sqrt(sqr(Xd-Xa)+sqr(Yd-Ya));
wind(3,10,76,5,white, black);
if (not ((AB=BC) and (BC=CD) and (CD=DA))) or
((Xb-Xa)*(Yc-Ya)=(Xc-Xa)*(Yb-Ya)) or
((Xb-Xa)*(Yd-Ya)=(Xd-Xa)*(Yb-Ya)) or
((Xc-Xb)*(Yd-Yb)=(Xd-Xb)*(Yc-Yb)) or
((Xd-Xc)*(Ya-Yc)=(Xa-Xc)*(Yd-Yc)) then
writeln(' romba s takimi koordinatami ne suschestvuet')
else
begin
writeln(' Koordinati peresecheniya dioganaley:');
writeln(' Xo= Yo=');
Xo:=(Xc-Xa)/2+Xa;
Yo:=(Yc-Ya)/2+Ya;
GoToXY(5,2);
write(Xo:2:2);
GoToXY(24,2);
write(Yo:2:2);
end;
GoToXY(5,5);
write('Press any key to exit');
repeat
until keypressed
END.
Заранее спасибо