Автор: Geroi 8.01.2003 20:23
Кто с этим дружит, напишите своё решение...
1. Две геометрические фигуры вырезаны из бумаги: квадрат со стороной A и ромб с диагоналями C и D (данные вещественные). Описать функцию, аргументами которой являются размеры фигур, а результатом будет TRUE, если одна фигура больше другой и по площади и по периметру, и FALSE в противном случае.
2. Задан массив из 20 целых чисел. Описать процедуру для распечатки на экране номера первого среди ненулевых элементов.
Или может продложение как их решать....
Автор: AlaRic 8.01.2003 22:26
Вроде что-то написал, но не уверен....проверьте если не трудно
Код
program r1;
uses wincrt;
var
a:array [1..20] of integer;
count,i:integer;
begin
randomize;
count:=0;
a[i]:=random(20);
for i:=1 to 20 do
begin
if a[i] <> 0 then count:=count+1;
end;
writeln(count);
end.
Автор: Вася 9.01.2003 2:13
Alaric -нужно написать функцию!!
Автор: Вася 9.01.2003 2:19
Код
program kontr_1;
uses wincrt;
var a,b,e:real;
function l(r,c,d:real):boolean;
var s1,s2,p1,p2:real;
begin
s1:=r*r;
s2:=0.5*c*d;
p1:=4*r;
p2:=2*sqrt(c*c+d*d);
if ((s1>s2) and (p1>p2)) or ((s2>s1) and (p2>p1))
then l:=true
else l:=false;
end;
begin
writeln('Ведите сторону квадрата');
readln(a);
writeln('Диагонали ромба');
readln(b,e);
writeln(l(a,b,e));
end.
Автор: jackal 9.01.2003 2:26
Код
Program t;
uses wincrt;
const d=20;
Type a=array [1..d] of integer;
var q:a;
i:byte;
Procedure ro(const q:a);
var i,k:byte;
t:integer;
begin
k:=0;
for i:=d downto 1 do
begin
if q[i]<>0 then
t:=q[i]
else
inc(k)
end;
writeln ('Первый ненулевой= ',t)
end;
begin
for i:=1 to d do
begin
writeln('Введите',i,' эл-т массива');
readln(q[i]);
end;
for i:=1 to d do
write(q[i]:4);
ro(q);
end.
Автор: jackal 9.01.2003 2:28
Ошибочка!!!
смотри ещё
Код
Program t;
uses wincrt;
const d=20;
Type a=array [1..d] of integer;
var q:a;
i:byte;
Procedure ro(const q:a);
var i:byte;
t:integer;
begin
k:=0;
for i:=d downto 1 do
begin
if q[i]<>0 then
t:=q[i]
end;
writeln ('Первый ненулевой= ',t)
end;
begin
for i:=1 to d do
begin
writeln('Введите',i,' эл-т массива');
readln(q[i]);
end;
for i:=1 to d do
write(q[i]:4);
ro(q);
end.
Автор: jackal 9.01.2003 2:30
ты будешь смеяться но строка к:=0 не нужна - у
меня похжая прога была
Автор: Ivs 9.01.2003 2:37
jackal, а почему ты просматриваеш массив с заду наперед, ведь в условии сказано найти первый?
и выводить надо не элемент а его номер.
Автор: Ivs 9.01.2003 2:40
выслал на мыл, но на всякий случай:
N_1 (easy)
Код
program Ivs_from_Geroi;
uses crt;
var
a,c,d:real;
function Size(a1,c1,d1:real):boolean;
var
S1,S2,P1,P2:real;
begin
S1:=sqr(a1); {Площадь квадрата}
S2:=0.5*c1*d1; {Площадь ромба}
P1:=4*a1; {Периметр квадрата}
P2:=4*(0.5*sqrt(sqr(c1)+sqr(d1))); {Периметр ромба (сам выводил, т.к. забыл)}
if ((S1>S2) and (P1>P2)) or ((S2>S1) and (P2>P1)) then Size:=True
else Size:=False;
end;
Begin
ClrScr;
write('Input -A- Square : ');readln(a);
write('Input -C- and -D- Romb: ');readln(c,d); {Вводятся через пробел}
write('Output: ',Size(a,c,d));
readln;
End.
N_2 (easy , но блин с этими массивами в процедурах явно что-то не ладное!)
Код
program Ivs_from_Geroi_2;
uses crt;
const n=20; {Размер массива}
var
a:array[1..n] of integer;
i:integer;
procedure Print(const a1:array of integer;const m:integer); {Передаем в процедуру в качестве формальных параметров констант}
var j:integer;
begin
for j:=1 to m do
if a1[j]<>0 then
begin
writeln('Index not null elements: ',j+1); { ????????? Но так выдает правильно, хотя по идее надо выводить j}
exit;
end;
end;
begin
ClrScr;
for i:=1 to n do
begin
write('a[',i,']= ');
readln(a[i]);
end;
Print(a,n);
readln;
end.