IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задачи...одна на описание фун-ии, 2-ая на процедур
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 29

Репутация: -  0  +


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


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


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

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Alaric -нужно написать функцию!!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Код

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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 17

Репутация: -  0  +


Код

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 17

Репутация: -  0  +


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

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 17

Репутация: -  0  +


ты будешь смеяться но строка к:=0 не нужна - у
меня похжая прога была
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Бывалый
***

Группа: Пользователи
Сообщений: 209

Репутация: -  0  +


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


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Бывалый
***

Группа: Пользователи
Сообщений: 209

Репутация: -  0  +


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


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 2:48
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name