С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Валерия_34
0 / 0 / 0
Регистрация: 09.09.2010
Сообщений: 41
1

case И ПРОЦУДУРЫ!

09.09.2010, 21:04. Просмотров 371. Ответов 5
Метки нет (Все метки)

Ввести с клавиатуры целое число.
1. Если остаток от деления этого числа на 5 равен 1, то найти длину самого короткого и самого длинного слова в строке.
2. Если остаток от деления этого числа на 5 равен 3, то учитывая сведения об игрушках: указываются названия игрушки, ее стоимость в рублях и возрастные границы. Для детей какого возраста предназначены кубики? Указать их среднюю стоимость.
3. Если остаток от деления этого числа на 5 равен 4, то в заданных матрицах-P(L,L) и F(M,M) вычислить и напечатать произведение отрицательных элементов, расположенных под главной диагональю.
4. Если остаток от деления этого числа на 5 равен 5, то построить график р(ф):= (Лемниската Бернули) в полярной системе координат.
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.09.2010, 21:04
Ответы с готовыми решениями:

case
при х=1,вывести на экран единицу.

CASE
Элементы равнобедренного прямоугольного треугольника пронумеровать следующим...

Case of
Как сделать выбор по пунктам? Например если нажать клавишу "1" (без enter) то...

Оператор Case
Как видите, сейчас чтобы компьютер показал нам день недели нужно указать цифру...

Оператор CASE
Составьте программу вычисления суммы цифр введенного с клавиатуры трехзначного...

5
Puporev
Модератор
55507 / 42595 / 29444
Регистрация: 18.05.2008
Сообщений: 100,754
10.09.2010, 13:09 2
Цитата Сообщение от Валерия_34 Посмотреть сообщение
Если остаток от деления этого числа на 5 равен 5
Пожалуйста, напишите хоть одно такое число...
0
Хохол
Эксперт С++
475 / 443 / 34
Регистрация: 20.11.2009
Сообщений: 1,292
10.09.2010, 13:12 3
Вот такое вот препода нынче задают
0
Puporev
Модератор
55507 / 42595 / 29444
Регистрация: 18.05.2008
Сообщений: 100,754
10.09.2010, 17:05 4
Поскольку у вас что-то с остатками не то 1,3,4,5, то написал по своему, можете переделать, только не пишите 5, нет такого.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
uses crt,graph;
procedure Slova;
const rz=['.',',',';',':','?','!'];
var s,s1,sk,sd:string;
    len,i,min,max:byte;
begin
writeln('Введите строку:');
readln(s);
for i:=1 to length(s) do{заменим разделители на пробелы}
if s[i] in rz then s[i]:=' ';
s:=s+' ';{добавим к ней пробел}
while pos('  ',s)>0 do{удалим лишние пробелы, в кавычках 2 пробела}
delete(s,pos('  ',s),1);{в кавычках 2 пробела}
if s[1]=' 'then delete(s,1,1);{если первый пробел, удаляем}
min:=255;{длина короткого слова}
max:=0;{длина короткого слова}
while pos(' ',s)>0 do{пока есть пробелы}
 begin
  len:=pos(' ',s)-1;{длина очередного слова}
  if len<min then{если меньше предыдущих}
    min:=len {его длина}
  else if len>max then{если больше предыдущих}
    max:=len; {его длина}
  delete(s,1,pos(' ',s));{удаляем проверенное слово, следующее первое}
 end;
writeln('Длина самого короткого слова=',min);
writeln('Длина самого длинного слова=',max);
readln
end;
procedure Igrushki;
type Tigr=record
          nam:string[20];
          stm:word;
          vz1:byte;
          vz2:byte;
          end;
const nmax=100;
var igr:array[1..nmax] of Tigr;
    n,i,k:byte;
    sr:real;
begin
clrscr;
{Создание массива записей}
repeat
write('Количество игрушек до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите данные об игрушках:');
for i:=1 to n do
 begin
  writeln('Игрушка ',i);
  with igr[i] do
   begin
    write('Название: ');readln(nam);
    write('Стоимость: ');readln(stm);
    repeat
    write('Минимальный возраст от 1 до 10): ');readln(vz1);
    until vz1 in [1..10];
    repeat
    write('Максимальный возраст от ',vz1+1,' до 14 : ');readln(vz2);
    until vz2 in [vz1+1..14];
  end;
 end;
clrscr;
{Вывод на экран}
writeln('Полный список игрушек:':30);
writeln;
writeln('--------------------------------------------------');
writeln('|   Название   |  Цена  | Ниж.возр. | Верх.возр. |');
writeln('--------------------------------------------------');
for i:=1 to n do
with igr[i] do
  begin
    gotoXY(1,whereY);write('| ',nam);
    gotoXY(16,whereY);write('| ',stm);
    gotoXY(25,whereY);write('|    ',vz1);
    gotoXY(37,whereY);write('|    ',vz2);
    gotoXY(50,whereY);writeln('|');
  end;
writeln('--------------------------------------------------');
k:=0;
for i:=1 to n do
if igr[i].nam='кубики' then
 begin
  k:=1;
  writeln('Кубики предназначены для детей от ',igr[i].vz1,' до ',igr[i].vz2,' лет');
  break;
 end;
if k=0 then
 begin
  writeln('Кубиков в списке нет! Поиск закончен');
  readln;
  exit;
 end;
k:=0;
sr:=0;
for i:=1 to n do
if igr[i].nam='кубики' then
 begin
  k:=k+1;
  sr:=sr+igr[i].stm;
 end;
sr:=sr/k;
writeln('Средняя стоимость кубиков=',sr:0:2);
readln
end;
procedure Matrica;
const nmax=20;
type matr=array[1..nmax,1..nmax] of real;
procedure Vvod(var a:matr;var n:byte;c:char);
var i,j:byte;
begin
writeln('Матрица ',c);
repeat
write('Размер матрицы=');
readln(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
 begin
   for j:=1 to n do
    begin
     a[i,j]:=10*random-5;
     write(a[i,j]:6:2);
    end;
   writeln;
 end;
writeln;
end;
function Prz(a:matr;n:byte):real;
var i,j,k:byte;
    p:real;
begin
k:=0;p:=1;
for i:=2 to n do
for j:=1 to i-1 do
if a[i,j]<0 then
 begin
  k:=1;
  p:=p*a[i,j];
 end;
if k=0 then Prz:=0
else Prz:=p;
end;
var P,F:matr;
    L,M:byte;
begin
Vvod(P,L,'P');
if Prz(P,L)=0 then writeln('Отрицательных ниже главной диагонали нет!')
else writeln('Произведение отрицательных ниже главной диагонали=',Prz(P,L):0:2);
Vvod(F,M,'F');
if Prz(F,M)=0 then writeln('Отрицательных ниже главной диагонали нет!')
else writeln('Произведение отрицательных ниже главной диагонали=',Prz(F,M):0:2);
readln
end;
procedure Lemniscata;
var x0,y0,d,gd,gm,i,x1,y1,fn,fk:integer;
    r,a,f,x,xr,yr:real;
    s:string;
begin
write('a=');readln(a);
fn:=0;
fk:=360;
gd:=0;
initgraph(gd,gm,'');
Setbkcolor(1);
x0:=getmaxX div 2;
y0:=getmaxY div 2;
{КООРДИНАТНАЯ  СЕТКА}
d:=round((y0-20)/(a*sqrt(2)));{шаг по оси радиуса в пикселях}
for i:=1 to round(a*sqrt(2)) do
 begin
  {рисуем окружности}
   circle(x0,y0,i*d);
  {пишем шкалу}
  str(i,s);
  outtextXY(x0+i*d+3,y0+10,s);
 end;
{рисуем касательные пунктиром}
  Setlinestyle(1,0,1);
  line(x0-y0,y0+y0,x0+y0,y0-y0);
  line(x0+y0,y0+y0,x0-y0,y0-y0);
{рисуем осевые линии сплошной линией}
Setlinestyle(0,0,1);
line(10,y0,getmaxX-10,y0);
line(x0,0,x0,getmaxY);
outtextXY(x0+5,y0+10,'0');
outtextXY(getmaxX-15,y0+10,'L');
{ГРАФИК}
x:=fn;
while x<=fk do
 begin
  if cos(2*x)>=0 then
   begin
    r:=a*sqrt(2*cos(2*x));
    xr:=r*cos(x);
    yr:=r*sin(x);
    x1:=x0+round(xr*d);
    y1:=y0-round(yr*d);
    putpixel(x1,y1,14);
   end;
  x:=x+0.01;
 end;
readln;
RestoreCrtMode;
end;
var k:integer;
begin
clrscr;
repeat
clrscr;
writeln('Vvedite celoe chislo k=');
readln(k);
case k mod 5 of
1:Slova;
2:Igrushki;
3:Matrica;
4:Lemniscata;
0:exit;
end;
until k mod 5=0;
end.
Добавлено через 1 минуту
Кстати если не знаете Лемнискату Бернулли, то гляньте здесь.
http://ru.wikipedia.org/wiki/%D0%9B%...BB%D0%BB%D0%B8
0
Валерия_34
0 / 0 / 0
Регистрация: 09.09.2010
Сообщений: 41
10.09.2010, 17:29  [ТС] 5
огромное спасибо!
0
Puporev
Модератор
55507 / 42595 / 29444
Регистрация: 18.05.2008
Сообщений: 100,754
10.09.2010, 19:34 6
Цитата Сообщение от Puporev Посмотреть сообщение
outtextXY(getmaxX-15,y0+10,'L');
В строке 189 замените L на a, от другой программы осталось.
0
10.09.2010, 19:34
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
10.09.2010, 19:34

программы на while и case..
WHILE Дан набор ненулевых целых чисел; признак его завершения число 0. Вывести...

case в паскале
надо составить программу, которая запрашивает масть карты (один из символов...

оператори if, else, case
Помогите решить задачу!!!! Очень нужно!!! Составить программу которая по...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru