Gavk
Junior Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Kareglazka
program fsb;
type matr=array[1..3] of real;
var a,b,c,l,xx,yy: matr;
i,j,k:integer; eps, p, s:real;
det:array[1..3,0..2] of real;
function det(x,y:matr;i,j:integer; eps:real):real;
var res:real;
begin
res:=x[i]*y[j]-x[j]*y[i];
if res>eps then det:=res else det:=0; {избавление от переполнения в случае параллельности пары прямых}
end;
procedure ReadMatr(var a,b,c:matr);
var k: integer;
for k:=1 to 3 do
begin
write('a[',k,']=');read(a[k]);
write('b[',k,']=');read(b[k]);
write('c[',k,']=');read(c[k])
end
end;
begin
write('Введите погрешность',eps);
ReadMatr(a, b, c);
d[1,0]:=det(a,b,1,2);
d[1,1]:=det(c,b,1,2);
d[1,2]:=det(a,c,1,2);
d[2,0]:=det(a,b,1,3);
d[2,1]:=det(c,b,1,3);
d[2,2]:=det(a,c,1,3);
d[3,0]:=det(a,b,2,3);
d[3,1]:=det(c,b,2,3);
d[3,2]:=det(a,c,2,3);
if (d[1,0]=0) or (d[2,0]=0) or (d[3,0]=0) then writeln ('Не получится треугольник')
else
begin { можно искать координаты точек}
for i:=1 to 3 do
begin
xx[i]:=d[i,1]/d[i,0];
yy[i]:=d[i,2]/d[i,0]
end;
dx:=xx[1]-xx[2];dy:=yy[1]-yy[2];
l[1]:=dx*dx+dy*dy;
dx:=xx[2]-xx[3];dy:=yy[2]-yy[3];
l[2]:=dx*dx+dy*dy;
dx:=xx[1]-xx[3];dy:=yy[1]-yy[3];
l[1]:=dx*dx+dy*dy;
p:=0;
for i:=1 to 3 do
p:=p+l[i];
p:=p/2; {полный периметр нам не зачем, а вот его половина - как раз }
s:=p;
for i:=1 to 3 do
s:=s*(p-l[i]); { получили квадрат площади}
s:=sqr(s);
writeln('Площадь треугольника составляет ',s:6:2)
end;
end.
|
)) 
