/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 590
от 02.03.2008, 11:35

Вопрос № 124.743

Здравствуйте, помогите, пожалуйста: 1)Дана последовательность действительных чисел a1, a2, ... an. Выяснить будет ли она возрастающей.(массив)

Отправлен: 25.02.2008, 13:39 Вопрос задала: Иванова Екатерина Сергеевна (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Tribak Здравствуйте, Иванова Екатерина Сергеевна! program www; const n=5; var a:array[1..n] of integer; i:integer; good:boolean; begin writeln('vvefite simvoli'); for i:=1 to n do readln(a[i]); good:=true; for i:=2 to n do if a[i]<a[i-1] then good:=false; if good then writeln('vozrastaet') else write('ne vozrastaet'); readln; end.

Ответ отправил: Tribak (статус: 8-ой класс) Ответ отправлен: 25.02.2008, 13:54 Оценка за ответ: 5

Отвечает: Шемет Станіслав Васильович Здравствуйте, Иванова Екатерина Сергеевна! вот программа в приложении: Приложение: const n=10; var m:array[1..n] of word; i:word; B:boolean; Begin for i:=1 to n do readln(m[i]); for i:=1 to n do if m[i]<=m[i+1] then b:=true else Begin b:=false; break; end; if not b then Write('не '); Writeln('возрастающая'); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 25.02.2008, 14:42 Оценка за ответ: 5

Отвечает: Попов Владимир Иванович Здравствуйте, Иванова Екатерина Сергеевна! Последовательность чисел задаётся в виде одномерного массива. Предельное число элементов массива регулируется значением константы Nmax. Проверка монотонности выполняется через определение знака разности между каждым следующим и предыдущим элементом. Счётчик количества нарушений монотонности проходит через переменную k. Цикл repeat-until позволяет осуществить запрос на повторный запуск программы. Исходник в приложении. Протестирован. Работает. Приложение: program q124743; uses crt; const Nmax=15; var a:array[1..Nmax] of real; ch:char; i,k:byte; n:integer; begin clrscr; repeat writeln; write(' Input the number of the elements in your Sequence : n = '); readln(n); if (n<=1) or (n>Nmax) then writeln(' Warning !!! Input error : n must be > 1 and <= ',Nmax) else begin for i:=1 to n do begin write(' a[',i,'] = '); readln(a[i]); end; k:=0; for i:=1 to n-1 do if (a[i+1]-a[i])<=0 then k:=k+1; if k=0 then writeln(' Your Sequence is monotonically increasing !') else writeln(' Your Sequence is NOT monotonically increasing !'); end; writeln; write('Again ? (y/n) - '); ch:=readkey; writeln; until (ch='n') or (ch='N'); end. --------- Physics forever !

Ответ отправил: Попов Владимир Иванович (статус: 2-ой класс) Ответ отправлен: 29.02.2008, 13:39

Вопрос № 124.774

Здравствуйте уважаемые эксперты. Помогите разобраться. 1. Есть задача: Дан массив. Определить количество полных квадратов среди элементов массива. Вывести исходный массив и все элементы массива, значение которых составляет полный квадрат. Че то я не пойму что такое "полный квадрат". Как его считать? 2. Вторая задача. Есть множество компьютеров. Компьютеры распределены по кафедрам. Мне нужно сформировать множество компьютеров, которых нет ни на одной кафедре. Код в приложении. Проблема в том, что я не могу вывести результат. Он пишет, что получаемый тип не предназначен для вывода. Точнее он ругается на переменную к. Помогите плиз. Приложение: program PK; uses crt; type tip=(IBM,PS2,MAC,ISKRA,ELECTRONIKA,PRAVICA,PENTIUM,DEC); var ISIT,VM,FIZIKA,HISTORY,ECONOMICA:set of tip; k:tip; tru:boolean; begin clrscr; ISIT:=[ISKRA,PENTIUM,MAC]; VM:=[IBM,DEC]; FIZIKA:=[IBM,MAC]; HISTORY:=[ISKRA]; ECONOMICA:=[ELECTRONIKA,IBM]; writeln('NA KAFEDRE NET COMPUTERS:'); for k:=IBM to DEC do if (per not in ISIT) and(per not in VM) and (per not in FIZIKA) and (per not in HISTORY) and (per not in ECONOMICA)} then writeln(tip(k)); readln; end.

Отправлен: 25.02.2008, 16:25 Вопрос задала: KInika (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, KInika! Программа в приложении. Число будет полным квадратом, если из него извлечь корень (ф-ция sqrt), взять целую часть (ф-ция trunc) и ее квадрат (ф-ция sqr) будет равен исходному числу. Удачи! Приложение: const N = 10; var A : array[1..N] of integer; var i, count : integer; begin randomize; for i := 1 to N do begin A[i] := random(1000); WriteLn(A[i]); end; WriteLn; count := 0; for i := 1 to N do if sqr(trunc(sqrt(A[i]))) = A[i] then inc(count); WriteLn(count); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 25.02.2008, 19:17 Оценка за ответ: 5 Комментарий оценки: Спасибо за помощь. Жаль только, что по поводу первой задачи ни не поделился мыслями.

Вопрос № 124.783

Помогите плиз никак немогу сделать,как только не пытался во собствено это задание: Сводная ведомость результатов экзаменационой сесии студенческой группы находится в файле на диске и для каждого студента содержит фамилию,инициалы и оценки по пяти дисциплинам.Количество студентов не привышает 20 человек.Составить программу,с помощью которой можно корректировать и дополнять список и получить: Список студентов,Список студентов-сдавших экзамены только на 5,Список студентов-имеющих 3. Приложение: Если можно с коментами плиз,спасибо заранее.

Отправлен: 25.02.2008, 17:08 Вопрос задал: Bandos (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станіслав Васильович Здравствуйте, Bandos! Перед тем как читать из файла информацию о студентах файл сначало надо создать. Если что не понятно пишите сюда Shemet_Stanislav@mail.ru Приложение: uses crt; const n=20; FileName='D:Student.txt'; Type Tstudent=record (*Тип студент*) LastName:string[100]; FIO:string[10]; Mark:array[1..5] of byte; end; VAr Student:array[1..n] of Tstudent;(*Массив з 20 студентами*) I,j:integer; F:text; Ch:char; Procedure Refresh; (*Процедура ввода информации о студентах*) begin for i:=1 to n do Begin Writeln; Write('Фамилия: '); Readln(student[i].LastName); Write('Ф.И.О: '); Readln(student[i].FIO); for j:=1 to 5 do Begin Write('Оценка: '); Readln(student[i].mark[j]); end; end; end; Procedure Write_File;(*Запись информации в файл о студентах*) begin Assign(f,FileName); Rewrite(f); for i:=1 to n do Begin Writeln(f,student[i].LastName); Writeln(f,Student[i].FIO); for j:=1 to 5 do Writeln(f,student[i].mark[j]); end; Close(f); end; Procedure Read_File;(*Чтение информации из файла о студентах*) Begin Assign(f,FileName); Reset(f); i:=0; Repeat inc(i); Readln(f,student[i].LastName); Readln(f,Student[i].FIO); for j:=1 to 5 do Readln(f,student[i].mark[j]); end; until (eof(f))or(i>=n) Close(f); end; Procedure All(x:byte);(*Процедура вывода информации о студентах*) var (*"Х" -Минимальная оценка которая должна быть у студента для его вывода на монитор*) B:boolean; begin for i:=1 to n do Begin b:=true; for j:=1 to 5 do(*Проверяем оценки студента*) if not ( Student[i].mark[j]>=x) then b:=false; if b then(*Если все они не ниже указанной оценки которая содержыться в Переменной "Х" то выводим о нем информацию*) Begin Writeln('Фамилия: ',Student[i].lastname); Writeln('Ф.И.О: ',Student[i].FIO); for j:=1 to 5 do Writeln('Оценка: ',Student[i].mark[j]); Writeln; end; end; end; begin ch:=#1; repeat(*Цикл с выбором нужных действий*) clrscr; Writeln('0 - Обновить студентов'); Writeln('1 - Сохранить информацию'); Writeln('2 - Получить информацию '); Writeln('3 - Вывести всех студентов'); Writeln('4 - Вывести студентов в которых оценка >=3'); Writeln('5 - Вывести студентов в которых оценка >=5'); Writeln('Esc - Выход'); Writeln; ch:=readkey; case ch of #48:refresh; #49:Write_file; #50:Read_file; #51:all(0); #52:all(3); #53:all(5); end; Writeln('Нажмите любую клавишу'); Readkey; until ch=#27; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 25.02.2008, 23:47

Вопрос № 124.800

дан массив ненулевых целых чисел.определить, сколько раз меняется знак элементов массива при его просмотре. например, в массиве 12,-4,13,77,-5,-99 знак меняется три раза.

Отправлен: 25.02.2008, 19:35 Вопрос задал: Юрченко Евгений Сергеевич (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Marked One !!! Здравствуйте, Юрченко Евгений Сергеевич! Код в приложении Ответ неверный! Например, если массив -1, -1, -2, -2, 3,-4,-5, то программа выдаст ответ 6. Правильный ответ -2. Правильное решение смотрите в следующем ответе. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 25.02.2008, 20:27 Приложение: var IArray:array [0..5] of Integer; i, j:Integer; begin j:=0; for i:=0 to 5 do if IArray[i]<0 then j:=j+1; Write('Знак меняется '); WriteLn(j); readln; end.

Ответ отправил: Marked One (статус: 6-ой класс) Ответ отправлен: 25.02.2008, 20:17 Оценка за ответ: 5

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Юрченко Евгений Сергеевич! Программа в приложении. Удачи! Приложение: const N = 10; var A : array[1..N] of integer; function MyRandom(MIN, MAX:integer):integer; {генерирует случайное число из промежутка MIN..MAX отличное от нуля} var t : integer; begin t := random(MAX-MIN)-MAX; while t = 0 do t := random(MAX-MIN)-MAX; MyRandom := t; end; var i, count : integer; begin { заполняем массив целыми числами не равными нулю } randomize; for i := 1 to N do begin A[i] := MyRandom(-20,20); WriteLn(A[i]); end; count := 0; for i := 2 to N do { проверяем, изменился ли знак в элементе A[k] по сравнению с A[k-1] если знак изменился, то произведение соседних элементов отрицательное, иначе - положительное } if A[i]*A[i-1] < 0 then inc(count); {если сменился, увеличиваем счетчик на единицу} WriteLn('Kolichestvo smen: ', count); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 25.02.2008, 20:21 Оценка за ответ: 5

Отвечает: Шемет Станіслав Васильович Здравствуйте, Юрченко Евгений Сергеевич! Вот как работает программа 1) заполняет массив случайными числами 2)далее идет такая проверка на изменения знака 1) смотрим знак текущего элемента если он отличается от следующего элемента, то увеличиваем збільшуємо(не знаю как это слово пишется по-русски) переменную Count на единицу if((m[i]<0)and(m[i+1]>0))or((m[i]>0)and(m[i+1]<0)) then - этот код проверяет отличаться ли соседние элементы массива по знаку. 3)Выводим значение Count на монитор. Слово переведено на русский язык. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 26.02.2008, 08:05 Приложение: const n=10; Var M:array[1..n]of integer; B:boolean; i:word; Count:word; Begin Randomize; For i:=1 to n do Begin m[i]:=Random(300); Dec(m[i],Random(220)); end; Count:=0; for i:=1 to n-1 do If ((m[i]<0)and(m[i+1]>0))or((m[i]>0)and(m[i+1]<0)) then inc(Count); Writeln(Count); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 26.02.2008, 00:16 Оценка за ответ: 5

Вопрос № 124.802

Дана информация о 20 сотрудниках фирмы: фамилия, имя, отчество,адрес и дата поступления на работу (год). 1. Вывести все данные о сотрудниках, проживающих в городе Москве. 2. Вывести все данные о сотрудниках имеющих имя вводимое с клавиатуры. Помогите плиз. заранее СПАСИБО!

Отправлен: 25.02.2008, 19:42 Вопрос задал: Симачков Сергей Юрьевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станіслав Васильович Здравствуйте, Симачков Сергей Юрьевич! Вот токо не пойму вот что(Вывести все данные о сотрудниках имеющих имя вводимое с клавиатуры) по этому зделал так: в конце каждой записи сотрудника необходима строка с даными было ли это имя вводимое с клавиатуры или нет . Вот пример такой записи: Рубченко - фамилия Роман - имя Романович - отчество Полтава - адрес 1980 - год 1 - Это тип char 1-вводимое с клавиатуры, 0 - вводимое не с клавиатуры Приложение: uses crt; const n=20; FileName='D:Work.txt'; Type TWork=record Name:string[50]; LastName:String[50]; Ochestvo:string[50]; Addres:string; Year:word; Klava:char; end; VAr Work:array[1..n] of Twork; i,Count:integer; f:text; ch:char; Procedure Read_file; Begin Assign(f,FileName); Reset(f); Count:=0; Repeat inc(Count); Readln(f,Work[i].Lastname); Readln(f,work[i].name); Readln(f,Work[i].Ochestvo); Readln(f,Work[i].addres); Readln(f,work[i].Year); Read(f,Work[i].klava); until eof(f); close(f); end; Procedure Write_monitor; Begin Writeln; Writeln('фамилия: ',Work[i].LastName); Writeln('имя: ',Work[i].Name); Writeln('отчество: ',Work[i].Ochestvo); Writeln('адрес: ',Work[i].addres); Writeln('дата поступления на работу (год): ',Work[i].Year); end; begin Read_file; Repeat Writeln('1 - Вывести все данные о сотрудниках, проживающих в городе Москве'); Writeln('2 - Вывести все данные о сотрудниках имеющих имя вводимое с клавиатуры'); Writeln('Esc - Выход'); ch:=readkey; case ch of #48: begin For i:=1 to count do if Work[i].name='Москва' then Write_monitor; end; #49: begin For i:=1 to count do if Work[i].klava='1' then Write_monitor; end; end; Writeln('Нажмите любую клавишу'); readkey; until ch=#27; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 26.02.2008, 01:05

Вопрос № 124.812

дан двумерный массив. найти сумму элементов главной диагонали массива.

Отправлен: 25.02.2008, 20:28 Вопрос задал: Юрченко Евгений Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Юрченко Евгений Сергеевич! Программа в приложении. Удачи! Приложение: const N = 10; var A : array[1..N, 1..N] of integer; var i,j, sum : integer; begin randomize; for i := 1 to N do begin for j := 1 to N do begin A[i,j] := random(10); Write(A[i,j]:3); end; WriteLn; end; WriteLn; sum := 0; for i := 1 to N do sum := sum + A[i,i]; WriteLn(sum); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 25.02.2008, 20:37 Оценка за ответ: 5

Отвечает: Шемет Станіслав Васильович Здравствуйте, Юрченко Евгений Сергеевич! Const X=10; Y=10; var M:array[1..x,1..y] of integer; Summa:Integer; i,j:byte; begin Randomize; For i:=1 to x do For j:=1 to y do M[i,j]:=random(2550); Summa:=0; For i:=1 to x do Summa:=m[i,i]+summa; Writeln('сумму элементов главной диагонали массива: ',Summa); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 25.02.2008, 23:55

Вопрос № 124.818

дана строка. вывести данную строку задом наперед......... Помогите еще с одной программой очень нада плиз

Отправлен: 25.02.2008, 20:44 Вопрос задал: Юрченко Евгений Сергеевич (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Юрченко Евгений Сергеевич! Программа в приложении. Удачи! Приложение: var s, s1 : string; i : integer; begin WriteLn('Vvedite stroku:'); ReadLn(s); for i := length(s) downto 1 do s1 := s1 + s[i]; WriteLn(s1); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 25.02.2008, 20:50 Оценка за ответ: 5

Отвечает: Marked One !!! Здравствуйте, Юрченко Евгений Сергеевич! Код в приложении Символы в строке нумеруются с единицы, а не с нуля. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 25.02.2008, 21:00 Приложение: var str, tempstr: string; i,j:integer; begin j:=0; { for i:=Length(str)-1 downto 0 do !!! неверно. нумерация символов в строке начинается с 1. Верный цикл написан ниже: } for i:=Length(str) downto 1 do tempstr[j]:=str[i]; inc(j); end; WriteLn(tempstr); end.

Ответ отправил: Marked One (статус: 6-ой класс) Ответ отправлен: 25.02.2008, 20:53

Отвечает: Зенченко Константин Николаевич Здравствуйте, Юрченко Евгений Сергеевич! В приложении программа. При использовании минимального количества переменнных. Удачи! Приложение: program q124818; var s:string; i:integer; begin {вводим строку} write('Enter:'); readln(s); {выводим в обратном порядке} writeln; for i:=length(s) downto 1 do write(s[i]); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 25.02.2008, 21:28

Отвечает: Шемет Станіслав Васильович !!! Здравствуйте, Юрченко Евгений Сергеевич! Var s:string; I:byte; Begin Readln(s); i:=length(s);(*I- длина строки*) for i:=i to 1 do(*цикл от длины строки до 1*) for i:=i downto 1 do Write(s[i]); (*выводим символы задом наперед *) Readln; end. Неверное использование цикла for. Правильное решение будет только при строке длиной 1 символ. Необходимо использовать цикл for .. downto .. do. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 25.02.2008, 22:12 --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 25.02.2008, 22:01

Вопрос № 124.839

приветствую.помогите пожалуйста с задачей... дан текст.определить количество слов, начинающихся и оканчивающихся с одной и той же буквы.

Отправлен: 25.02.2008, 23:09 Вопрос задал: родион (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, родион! Программа в приложении. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; Function CountWords(s : String) : Integer; var res : integer; begin {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); res := 0; s := Trim(s); While pos(' ',s)>0 do begin s := copy(s, pos(' ',s)+1, Length(s) - pos(' ', s)); s := Trim(s); inc(res) end; CountWords := res+1; End; Function GetWord(s : String; i : Integer) : String; var s1 : string; k : integer; begin s1 := s; For k := 1 To i - 1 do s1 := trim(copy(s1, pos(' ',s1)+1, Length(s1) - pos(' ', s1)+1)); If pos(' ', s1) > 0 Then GetWord := copy(s1, 1, pos(' ',s1) - 1) Else GetWord := Trim(s1); End; function check(s:string;a,b:integer):boolean; var res : boolean; w1, w2 :string; begin w1 := getword(s,a); w2 := getword(s,b); check := (w1[1] = w2[1])and(w1[length(w1)] = w2[length(w2)]) end; const symbols = ',:;.!?'; { znaki prepinaniya } var s, word, last_word : string; i, k, c, count : integer; begin WriteLn('Vvedite stroku:'); ReadLn(s); WriteLn; if trim(s) <> '' then begin { change all symbols to spaces } for i := 1 to length(s) do if (pos(copy(s,i,1),symbols)>0) then begin insert(' ',s,i); delete(s,i+1,1); end; {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); c := countwords(s); count := 0; for i := 1 to c-1 do for k := i+1 to c do begin if check(s, i, k) then begin WriteLn(getword(s,i), ' -- ', getword(s,k)); {удалите эту строчку, если слова с одинаковыми первой и последней буквой не надо выводить на экран} inc(count); end; end; end; WriteLn; WriteLn('Kol-vo: ',count); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.02.2008, 08:01 Оценка за ответ: 5

Вопрос № 124.848

Здравствуйте! Помогите пожалуйста сделать данную программу: Даны даты 20 событий, произошедших после 1917 года - год, номер месяца,число.Необходимо следующее: 1.Добавить событие 2.Вывод на экран всех событий года, введенного с клавиатуры 3.Вывод на экран всех событий Заранее благодарен!

Отправлен: 26.02.2008, 00:24 Вопрос задал: Saiks (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станіслав Васильович Здравствуйте, Saiks! Программа в приложении. Если что не ясно обращайтесь. Приложение: uses crt; const n=20; Type Tmessage=record Year:word; Monce:1..12; day:1..31; end; var Message:array[1..n] of Tmessage; ColMessage:byte; i,j:integer; ch:char; Procedure add_Message; begin inc(colmessage); Writeln; Write('Год: '); Readln(message[colmessage].year); Write('Месяц: '); Readln(message[colmessage].monce); Write('Число: '); Readln(message[colmessage].day); end; Procedure Write_Message(x:byte); begin Writeln; Writeln('Год: ',Message[x].year); Writeln('Месяц: ',Message[x].monce); Writeln('Число: ',Message[x].day); Writeln; end; Procedure Message_In_Year(year:word); begin if colmessage>0 then for i:=1 to colmessage do if message[i].year=year then Write_message(i) else Writeln('Нету сообщения '); end; begin ColMessage:=0; ch:=#1; Repeat clrscr; Writeln('1 - Добавить событие'); Writeln('2 - Вывод на экран всех событий года, введенного с клавиатуры'); Writeln('3 - Вывод на экран всех событий'); Writeln('Esc - Выход'); ch:=Readkey; Case ch of '1':add_message; '2':Begin Write('Год: '); Readln(j); if j<=colmessage then Message_in_year(j) else Writeln('События нету'); end; #51:for j:=1 to colmessage do Write_message(j); end; Write('Нажмите любую клавишу'); Readkey; until ch=#27; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 26.02.2008, 02:57 Оценка за ответ: 5

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.71 от 27.02.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru