Снова ТПУ-модуль
Снова здраствуйте. надо было дописать одну функцию в программу не могу правильно втпу вставить и совместить с основной програмой. Что опять тут не так:tehnari_ru_837:
Ну собственно функция
Код:
function priv(t: trg): boolean;
a, b, c: real;
begin
writeln('Введите три стороны треугольника: ');
a:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1));
b:=sqrt((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2)+(z3-z2)*(z3-z2));
c:=sqrt((x1-x3)*(x1-x3)+(y1-y3)*(y1-y3)+(z1-z3)*(z1-z3));
prv:=(a + b > c) and (a + c > b) and (b + c > a);
if priv(a, b, c) then writeln('Треугольник с такими сторонами существует')
else writeln('Треугольника с такими сторонами не существует');
writeln
end;
так в тпу
Код:
unit Prv;
interface
uses syschestvovanie_treygolnika;
function priv(t: trg):boolean; //существование треуг.
implementation
function priv(t: trg): boolean;
begin
writeln('Введите три стороны треугольника: ');
a:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1));
b:=sqrt((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2)+(z3-z2)*(z3-z2));
c:=sqrt((x1-x3)*(x1-x3)+(y1-y3)*(y1-y3)+(z1-z3)*(z1-z3));
prv:=(a + b > c) and (a + c > b) and (b + c > a);
if priv(a, b, c) then writeln('Треугольник с такими сторонами существует')
else writeln('Треугольника с такими сторонами не существует');
writeln
end;
end.
ну и основная программа
Код:
program Osnova;
uses
crt, Syschestvovanie_treygolnika, Ploshad, Perimetr,Prv;
var
f1, f2: file of trg;
z: trg;
n, i, k, kl: integer;
a, b: real;
begin
clrscr;
randomize;
assign(f1, 'input');
rewrite(f1);
assign(f2, 'output');
rewrite(f2);
writeln('Введите число треугольников:');
readln(n);
for i := 1 to n do
begin
z.x1 := -1.2 + 2.4 * random;
z.y1 := -1.2 + 2.4 * random;
z.x2 := -1.2 + 2.4 * random;
z.y2 := -1.2 + 2.4 * random;
z.x3 := -1.2 + 2.4 * random;
z.y3 := -1.2 + 2.4 * random;
write(f1, z)
end;
if priv(z) then //сюда вставить функцию надо
writeln('Содержание файла F1');
seek(f1, 0);
k := 0;
kl := 0;
while not eof(f1) do
begin
read(f1, z);
k := k + 1;
writeln(k:2, ') A (', z.x1:5:2, ' ', z.y1:5:2, ') B (', z.x2:5:2, ' ', z.y2:5:2, ')'
' C (', z.x3:5:2, ' ', z.y3:5:2, ')');
if k mod 20 = 0 then
begin
writeLn('Press Enter');
readln
end;
if prin(z) then
begin
kl := 1;
z.s := plos(z);
z.p := perm(z);
write(f2, z);
end;
end;
close(f1);
if kl = 0 then
begin
writeLn('Нет треугольников, целиком лежащих в данном круге');
close(f2);
exit
end;
repeat
writeln('Введите интервал для поиска a < b');
readln(a, b);
until a < b;
seek(f2, 0);
writeln('Содержание файла F2');
k := 0;
kl := 0;
while not eof(f2) do
begin
read(f2, z);
k := k + 1;
writeln(k:2, ') A (', z.x1:5:2, ' ', z.y1:5:2, ') B (', z.x2:5:2, ' ', z.y2:5:2, ')'
' C (', z.x3:5:2, ' ', z.y3:5:2, ')');
writeln( 'S = ', z.s:5:2, ' P = ', z.p:5:2);
if k mod 20 = 0 then
begin
writeLn('Press Enter');
readln
end;
if ((z.s >= a) and (z.s <= b)) or ((z.p >= a) and (z.p <= b)) then kl := kl + 1;
end;
writeln('Количество треугольников, у которых площадь или периметр');
writeln('попадают в заданный интервал=', kl);
close(f2);
end.
|
