Задачи...одна на описание фун-ии, 2-ая на процедур Опции

[Geroi]

Кто с этим дружит, напишите своё решение...
1. Две геометрические фигуры вырезаны из бумаги: квадрат со стороной A и ромб с диагоналями C и D (данные вещественные). Описать функцию, аргументами которой являются размеры фигур, а результатом будет TRUE, если одна фигура больше другой и по площади и по периметру, и FALSE в противном случае.
2. Задан массив из 20 целых чисел. Описать процедуру для распечатки на экране номера первого среди ненулевых элементов.
Или может продложение как их решать....

[AlaRic]

Вроде что-то написал, но не уверен....проверьте если не трудно

Код

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.

Сообщение отредактировано: volvo - 17.12.2004 6:01

[Вася]

Alaric -нужно написать функцию!!

[Вася]

Код

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.

Сообщение отредактировано: volvo - 17.12.2004 6:02

[jackal]

Код

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.

Сообщение отредактировано: volvo - 17.12.2004 6:03

[jackal]

Ошибочка!!!
смотри ещё

Код

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.

Сообщение отредактировано: volvo - 17.12.2004 6:03

[jackal]

ты будешь смеяться но строка к:=0 не нужна - у
меня похжая прога была

[Ivs]

jackal, а почему ты просматриваеш массив с заду наперед, ведь в условии сказано найти первый?
и выводить надо не элемент а его номер.

[Ivs]

выслал на мыл, но на всякий случай:
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.