Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 117 ∙ повысить рейтинг >>

Botsman Статус: 7-й класс Рейтинг: 90 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 55 ∙ повысить рейтинг >>

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

Выпуск № 821
от 28.02.2009, 10:05

Вопрос № 161106: Здравствуйте,помогите пожалуйста! a) Создать типизированный файл заданной структуры, заполнить его информацией, вывести данные в виде таблицы на экран. (Файлы, создаваемые в задании, должны содержать не менее 5-ти строк). b) Разработать подпр...

Вопрос № 161.106

Здравствуйте,помогите пожалуйста! a) Создать типизированный файл заданной структуры, заполнить его информацией, вывести данные в виде таблицы на экран. (Файлы, создаваемые в задании, должны содержать не менее 5-ти строк). b) Разработать подпрограмму обработки данного файла. вот мой вариант: a) Создать файл, содержащий сведения об ассортименте игрушек в магазине: название игрушки, цена, количество, возрастная группа, например 2-5, т.е. от 2 до 5. b) Создать файл, содержащий список игрушек, которые по стоимости не превышают X рублей и подходят ребенку в возрасте от A до B лет. Значения X, A, B ввести с терминала. вот листинг! помоги по нему сделать второе задание: Выполнить ЗАДАНИЕ 1 с использованием текстового файла. Данные в текстовый файл вывести в виде таблицы. и еще вопрос! как сделать,чтоб после 6 игрушек ввод заканчивался,а то у меня до бесконечности печатает! Приложение: program r3_3; uses crt; var f1,f2:text; name:string; procedure zapoln(var f:text); var z:string[10]; a,i:integer; begin rewrite(f); writeln('Assortiment:'); writeln('nazvanie, cena, k-vo, min_vozrast, max_vozrast'); write('--------------------------------------------------------------------------------'); While not eof do begin readln(z); write(f,z:11); for i:=1 to 4 do begin readln(a); write(f,a:6); end; writeln(f,''); write('--------------------------------------------------------------------------------'); end; close(f); writeln('press any key'); readln; end; procedure viv(var f:text); var z:string; begin {$i-} reset(f); {$i+} if ioresult<>0 then writeln('no file') else begin writeln('------------------------------------------------------------------------'); writeln(' nazvanie cena k-vo vozrast'); while not eof(f) do begin readln(f,z); writeln(z); end; close(f); writeln; writeln('press enter...'); end; readln; end; procedure new_f(var f1,f2:text); var z,x:string; a,b,c,a1,b1,c1,err:integer; begin reset(f1); rewrite(f2); writeln('vv max cenu i vozrast (ot i do):'); readln(c,a,b); while not eof(f1) do begin readln(f1,z); x:=copy(z,13,5); val(x,c1,err); x:=copy(z,25,5); val(x,a1,err); x:=copy(z,31,5); val(x,b1,err); if (c1<=c)and(a1<=a)and(b1>=b) then write(f2,z); end; close(f1); close(f2); readln; end; begin clrscr; writeln('vv ima faila:'); readln(name); assign(f1,name+'.txt'); zapoln(f1); viv(f1); writeln('vv ima 2go faila:'); readln(name); assign(f2,name+'.txt'); new_f(f1,f2); viv(f2); readln; end.

Отправлен: 22.02.2009, 09:53 Вопрос задал: БИКМЕРЗА ПРАЙД (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Комаров Антон Сергеевич! Вот решение то ли задания №1, то ли №2, запутали Вы нас изрядно. Короче с типизированными файлами. Задание №3 предлагаю сделать так. 1.Создать текстовый файл с нужными данными, куда в строку через пробел, или запятую вписать данные по каждому наименованию игрушки.Файл либо писать латинскими буквами, либо конвертировать из Win в Dos. 2.Считать данные программно в записи. 3.Обработать их по условию. 4.Вывести в виде таблицы в новый текстовый файл. Мне кажется это логичным. Если Вас это устроит, я напишу Вам программу, либо приведите четкое условие задания №3. Приложение: uses crt; type Tigr=record nam:string[20]; stm:word; kol:word; vz1:byte; vz2:byte; end; var igr:Tigr;{переменная типа записи для ввоода и вывода информации} f,g:file of Tigr;{2 типизированных файла записей} X:word;{макс.цена} A,B:byte;{нижний и верхний возрастные граеицы} begin clrscr; {Sozdanie faila} assign(f,'igr1.dat'); rewrite(f); repeat with igr do begin write('Nazvanie: ');readln(nam); write('Cena: ');readln(stm); write('Kolichestvo: ');readln(kol); write('Min vozrast: ');readln(vz1); write('Max vozrast: ');readln(vz2); end; write(f,igr);{записываем в файл} until readkey=#27;{ожидем нажатия клавиши, если Esc, прекращаем ввод} clrscr;{очистим экран от ввода} {Vyvod faila na ekran} reset(f); writeln('Polnyj spisok igrushek:':40); writeln; writeln('----------------------------------------------------------'); writeln('| Nazvanie | Cena | Kolichestvo | Niz.voz | Ver.voz |'); writeln('-----------------------------------------------------------'); while not eof(f) do begin read(f,igr); with igr do begin gotoXY(1,whereY);write('| ',nam); gotoXY(16,whereY);write('| ',stm); gotoXY(25,whereY);write('| ',kol); gotoXY(39,whereY);write('| ',vz1); gotoXY(49,whereY);write('| ',vz2); gotoXY(59,whereY);write('|'); end; writeln; end; readln; close(f);{файл полностью прочитан, закроем его} {Sozdanie faila po usloviyu} clrscr; reset(f);{снова откроем} assign(g,'igr2.dat');{новый файл для записи} rewrite(g); write('Stoimost igrushki: ');readln(X);{вводим данные для запроса} repeat write('Niznij vozrastnoj predel: ');readln(A); write('Verhnij vozrastnoj predel: ');readln(B); until (A>0)and(B>0)and(B>A); while not eof(f)do begin read(f,igr); {читаем первый файл} if (igr.stm<=X)and(igr.vz1<=A)and(igr.vz2>=B){если условия подходят} then write(g,igr);{записываем в новый файл} end; {Vvyvod dannyh na ekran} reset(g);{открываем для чтения новый файл} writeln('Spisok igrushek po zaprosu:':40); writeln; writeln('----------------------------------------------------------'); writeln('| Nazvanie | Cena | Kolichestvo | Niz.voz | Ver.voz |'); writeln('-----------------------------------------------------------'); while not eof(g) do begin read(g,igr); with igr do begin gotoXY(1,whereY);write('| ',nam); gotoXY(16,whereY);write('| ',stm); gotoXY(25,whereY);write('| ',kol); gotoXY(39,whereY);write('| ',vz1); gotoXY(49,whereY);write('| ',vz2); gotoXY(59,whereY);write('|'); end; writeln; end; close(f);{закрываем оба файла} close(g); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 24.02.2009, 13:19 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244348 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Это действительно специалисты и мастера своего дела!!!!!!!

Вопрос № 161.121

Здравствуйте, мне нужна помощь в решении вот такой задачи на паскаль. N! − это произведение натуральных чисел от 1 до N (1 ≤ N ≤ 32767). Например, 7! = 5040. Требуется написать программу, которая по заданному N определит самую правую ненулевую цифру в записи N! Пример входных данных: 7, пример выходных данных: 4.

Отправлен: 22.02.2009, 15:00 Вопрос задала: юлия (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Delph Здравствуйте, юлия! В приложении один из вариантов решения задачи. Программа запрашивает входной параметр N, после чего проводит расчёт. После каждой операции умножения отбрасываются нули в правой части числа (если они есть). Поскольку факториал числа возрастает невероятно быстро, отбрасываются так же все значащие цифры, кроме самой правой - её вполне достаточно для получения требуемого результата. При необходимости можно вывести не только одну, но и несколько значащих цифр. Желаю успехов! Приложение: { Немного модифицированная программа; искренне благодарю Шевченко Дмитрия за указание на странную особенность, связанную с необходимостью держать в памяти не одну, а несколько значащих цифр } Program Pr161121; Uses CRT; Var i, N: Integer; s: Longint; { расширенный целый тип } Begin ClrScr; WriteLn('Введите натуральное число от 1 до 32767:'); Repeat Write('N = '); ReadLn(N); Until N > 0; s := 1; for i := 2 to N do begin s := s * i; { отбрасываем нули в правой части числа } while (s mod 10 = 0) do s := s div 10; { оставляем последние значащие цифры } s := s mod 10000; end; WriteLn('Последня цифра в факториале: ', s mod 10); ReadLn End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 22.02.2009, 15:46 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244232 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 161.123

Здравствуйте уважаемые эксперты. Вот немогу решить задачу на паскале. Требуется разработать программу управления лифтом для пятиэтажного здания в паскале. Лифт будет двигаться вверх, если нажата кнопка этажа, находящегося выше кабины лифта. Лифт будет двигаться вниз, если нажата кнопка этажа, находящегося ниже кабины лифта. Две кнопки не могут быть нажаты одновременно. Если при движении отпущена кнопка, то лифт остановится. У меня есть решение этой задачи для трех этажного здания, а вот для пяти сообразить не могу. Заранее спасибо за все ответы. Приложение: Program Lift1; uses crt; var k1,k2,k3,d1,d2,d3,Yup,Ydown,Ydoor: boolean; NewLY,OldLY: byte; ch: char; Procedure DrawHouse; var x,y,z: byte; begin textcolor(7); for z:=1 to 3 do begin for x:=1 to 20 do begin gotoxy(x+10,z*10); write('ю'); gotoxy(x+10,40); write('ю'); end; for y:=1 to 10 do begin gotoxy(11,z*10+y); write('ю'); gotoxy(30,z*10+y); write('ю'); end; end; end; Procedure DrawLift; var y: byte; begin textcolor(15); for y:=1 to 9 do begin gotoxy(13,y+OldLY);write(' '); end; for y:=1 to 9 do begin gotoxy(13,y+NewLY);write('юююююююю'); end; end; procedure YLift; begin if (NewLY>=10) and (NewLY<=19) then D3:=true else D3:=false; if (NewLY>=11) and (NewLY<=29) then D2:=true else D2:=false; if (NewLY>=21) and (NewLY<=30) then D1:=true else D1:=false; if (D1 and not(D2) and not(D3) and not(K1) and K2 and not(K3)) or (D1 and D2 and not(D3) and not(K1) and K2 and not(K3)) or (D1 and not(D2) and not(D3) and not(K1) and not(K2) and K3) or (D1 and D2 and not(D3) and not(K1) and not(K2) and K3) or (not(D1) and D2 and not(D3) and not(K1) and not(K2) and K3) or (not(D1) and D2 and D3 and not(K1) and not(K2) and K3) then Yup:=true else Yup:=false; if (D1 and D2 and not(D3) and K1 and not(K2) and not(K3)) or (not(D1) and D2 and not(D3) and K1 and not(K2) and not(K3)) or (not(D1) and D2 and D3 and K1 and not(K2) and not(K3)) or (not(D1) and not(D2) and D3 and K1 and not(K2) and not(K3)) or (not(D1) and D2 and D3 and not(K1) and K2 and not(K3)) or (not(D1) and not(D2) and D3 and not(K1) and K2 and not(K3)) then Ydown:=true else Ydown:=false; if (D1 and not(D2) and not(D3) and K1 and not(K2) and not(K3)) or (not(D1) and D2 and not(D3) and not(K1) and K2 and not(K3)) or (not(D1) and not(D2) and D3 and not(K1) and not(K2) and K3) then Ydoor:=true else Ydoor:=false; end; begin OldLY:=13; NewLY:=13; K1:=false; K2:=false; K3:=false; clrscr; Ylift; DrawHouse; DrawLift; repeat ch:=readkey; OldLY:=NewLY; if ch='1' then K1:=true else K1:=false; if ch='2' then K2:=true else K2:=false; if ch='3' then K3:=true else K3:=false; Ylift; if Yup then dec(NewLY); if Ydown then inc(NewLY); gotoxy(1,1);writeln(D1,' ',D2,' ',D3,' ',newly); DrawHouse; DrawLift; until ch='0'; end.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Sam145! Немного упростил Вашу программу - теперь при нажатии номера этажа она просто запоминает "высоту", на которую должен приехать лифт. Если лифт ниже этой высоты - он перемещается вверх, если выше - вниз. Чтобы корректно отображалось всё здание - надо на заголовке консоли при работе программы нажать правой кнопкой мыши, выбрать "Умолчания" - "Расположение" - "Размер окна" - "Высота" и поставить там не менее 53 и перезапустить программу. Успехов! С уважением, Дмитрий. Приложение: Program Lift1; uses crt; var NewLY,OldLY,NeedY: byte; ch: char; Procedure DrawHouse; var x,y,z: byte; begin textcolor(7); for z:=0 to 4 do{рисуем 5 этажей} begin for x:=1 to 20 do begin gotoxy(x+10,z*10+3); write('■'); gotoxy(x+10,(z+1)*10+3); write('■');{рисуем нижнюю грань этажа} end; for y:=1 to 10 do begin gotoxy(11,z*10+3+y); write('■'); gotoxy(30,z*10+3+y); write('■'); end; end; end; Procedure DrawLift; var y: byte; begin textcolor(15); for y:=1 to 9 do begin gotoxy(13,y+OldLY);write(' '); end; for y:=1 to 9 do begin gotoxy(13,y+NewLY);write('■■■■■■■■'); end; end; begin OldLY:=13; NewLY:=13; clrscr; DrawHouse; DrawLift; repeat ch:=readkey; OldLY:=NewLY; case ch of{в зависимости от нажатой клавиши запоминаем на какой высоте должен оказаться лифт} '1': NeedY:=43; '2': NeedY:=33; '3': NeedY:=23; '4': NeedY:=13; '5': NeedY:=3; Else NeedY:=OldLY;{если нажали не 1-5 - стоим на месте} end; IF OldLY < NeedY then{если он выше этой высоты - идём вниз} inc(NewLY); IF OldLY > NeedY then{если он ниже - вверх} dec(NewLY); DrawHouse; DrawLift; until (ch='0')or(ch = #27);{выходим при нажатии '0' или 'Esc'} end.

Ответ отправил: Шевченко Дмитрий (статус: Студент) Ответ отправлен: 22.02.2009, 18:02 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244239 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Большое спасибо, а то я не знал как упростить эти условия.

Вопрос № 161.126

Здравствуйте, уважаемые эксперты Помогите пожалуйста со следующими задачами: 1) Решить с помощью рекурсии следующую задачу - "Ханойская башня". Имеются три колышка A,B,C и N дисков разного диаметра на A, пронумерованных от 1 до N в порядке возрастания из размеров. Требуется перенести все диски с колышка A на колышек C, соблюдая при этом следующие условия : диски можно переносить только по одному, больший диск нельзя ставить на меньший. 2) Описать переменную "экзаменационная ведомость" (предмет, номер группы, список студентов данной группы, их оценки). Определить отличников, хорошистов, троечников и двоечников. 3) через файл открыть текст и удвоить в тексте каждую литеру. Заранее благодарен

Отправлен: 22.02.2009, 15:47 Вопрос задал: Тупак Шакур (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Тупак Шакур! Решение задач №2,3 с пояснениями в приложении. Приложение: №2. uses crt; const nmax=50;{максимальное число студентов} type Tstud=record {тип запись студент с полями} fam:string[20];{фамилия} ocn:2..5;{оценка} end; Tspis=array[1..nmax]of Tstud;{тип массив записей студентов} Tvedomost=record {тип запись ведомость с полями} prd:string[20];{предмет} grp:word;{номер группы} sps:Tspis;{список студентов с оценками} end; var n,i:byte; ved:Tvedomost;{переменная тиа ведомость} begin clrscr; repeat write('Vvedite kolichectvo studentov n='); readln(n); until (n>0)and(n<=nmax);{вводим с проверкой правильности число студентов} write('Predmet: ');readln(ved.prd);{заполняем ведомость данными} write('Nomer gruppy: ');readln(ved.grp); writeln('Spisok studentov, ocenki:'); for i:=1 to n do begin writeln(' Student ',i); write(' Familia: ');readln(ved.sps[i].fam); write(' Ocenka: ');readln(ved.sps[i].ocn); end; clrscr;{очищаем экран от ввода} writeln('Sdali na otlichno:');{выбираем у кого 5} writeln('Predmet - ',ved.prd,' Gruppa - ',ved.grp); for i:=1 to n do if ved.sps[i].ocn=5 then writeln(ved.sps[i].fam); readln; writeln('Sdali na horosho:');{тоже 4} writeln('Predmet - ',ved.prd,' Gruppa - ',ved.grp); for i:=1 to n do if ved.sps[i].ocn=4 then writeln(ved.sps[i].fam); readln; writeln('Sdali na udovletvoritelno:');{тоже 3} writeln('Predmet - ',ved.prd,' Gruppa - ',ved.grp); for i:=1 to n do if ved.sps[i].ocn=3 then writeln(ved.sps[i].fam); readln; writeln('Sdali neudovletvoritelno:');{тоже 2} writeln('Predmet - ',ved.prd,' Gruppa - ',ved.grp); for i:=1 to n do if ved.sps[i].ocn=2 then writeln(ved.sps[i].fam); readln end. №3. uses crt; const lt=[65..90,97..122,168,184,192..255];{коды букв по ANSI} var f,g:text;{2 текстовых файла} s:string;{строка} i:byte;{счетчик цикла} begin clrscr; assign(f,'text1.txt');{связываем переменную с существующим файлом} reset(f);{открываем для чтения} assign(g,'text2.txt');{создаем новый файл} rewrite(g);{открываем для записи} while not eof(f) do{пока не конец файла} begin readln(f,s);{читаем построчно} i:=1; while i<=length(s) do{идем по строке} begin if ord(s[i]) in lt then insert(s[i],s,i+1);{если литера, вставляем еще одну такую же} inc(i,2);{увеличиваем счетчик на 2} end; writeln(g,s);{записываем строку в новый файл} end; close(f);{закрываем оба файла} close(g); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.02.2009, 11:57 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244270 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 161.164

Помогите пожалуйста. 1) В массиве А(k,l) исключить строку, содержащую наибольшее количество нулевых элементов

Отправлен: 23.02.2009, 08:27 Вопрос задал: Kuvart2009 Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Kuvart2009! Решение первой задачи с пояснениями в приложении. Приложение: 1)В массиве А(k,l) исключить строку, содержащую наибольшее количество нулевых элементов uses crt; const nmax=20; {максимальный размер матрицы} var a:array[1..nmax,1..nmax] of byte;{тип матрицы, числа от 0 до 256} k,l,i,j,n,max,imax:byte; begin clrscr; randomize; repeat {вводим размеры матрицы с проверкой правильности ввода} write('Vvedite kolichestvo strok: '); readln(k); until (k>0)and(k<=nmax); repeat write('Vvedite kolichestvo stolbcov: '); readln(l); until (l>0)and(l<=nmax); writeln('Ishodnaya matrica:'); for i:=1 to k do for j:=1 to l do a[i,j]:=random(4);{заполняем матрицу числами от 0 до 3} max:=0;imax:=1; for i:=1 to k do begin n:=0; for j:=1 to l do if a[i,j]=0 then inc(n);{считаем в каждой строке ноли} if n>max then begin max:=n;{находим где больше} imax:=i;{запоминаем эту строку} end; end; for i:=1 to k do begin for j:=1 to l do if i=imax then {строку с макс. кол. нолей выделяем ярко-красным цветом} begin Textcolor(12); write(a[i,j]:3); end else {остальные обычным, чаще это белый} begin Textcolor(15); write(a[i,j]:3); end; writeln; end; for i:=imax to k-1 do {от строки с макс. кол. нолей до предпоследней} for j:=1 to l do a[i,j]:=a[i+1,j];{ всем элементам присваиваем значения следующей строки, строка с которой начали исчезает} dec(k);{уменьшаем на 1 кол. строк} writeln('Rezultat:'); for i:=1 to k do begin for j:=1 to l do write(a[i,j]:3); writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.02.2009, 10:28 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244265 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

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