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

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

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

Тимошенко Дмитрий Статус: Студент Рейтинг: 133 ∙ повысить рейтинг >>

Botsman Статус: Практикант Рейтинг: 119 ∙ повысить рейтинг >>

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

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

Выпуск № 882
от 16.05.2009, 05:35

Вопрос № 166868: Здравствуйте, помогите пожалуйста <img src="http://rusfaq.ru/images/Forum/5.gif" border="0"> решить хотябы одну задачу по файлам и одну по записям: <div style="margin:5px; margin-top:5px"><div class="S"><b><font color="gray">© Цитата: <...

Вопрос № 166.868

Здравствуйте, помогите пожалуйста решить хотябы одну задачу по файлам и одну по записям: © Цитата: 1. Задача по файлам Сформировать файл целых чисел. Получить новый файл целых чисел, содержащий исходные числа, десятичные цифры которых записаны в обратном порядке, рассортировать новый файл по возрастанию чисел. 2. Задача по записям В группе студентов диапазоны Ф.И.О., дата рождения 1)Вывести ФИО тех, у кого в данном месяце день рождения 2)Вывесли ФИО юбиляров в этом году 3)Рассортировать всех по возрасту ©  ;Цитата: В приложении я так..начало сочинил у программы по записям, решил уж тут напечатать, чтобы не подумали что я не пытался)...Я не знаю как именно лучше делать и т.д., и какой тип указывать в дате рождения...Напишите решение так, как на Ваш взгляд будет лучше...ФИО я нормально хоть сделал или нет, незнаю...но тип точно стринг...в общем выручайте люди добрые! ЗАРАНЕЕ СПАСИБО! p.s. Я хочу помочь порталу в плане дизайна (учусь еще но умею в принципе наверное уже нормально...), к кому обращаться? Сразу говорю безвоздмездно хочу помочь!;) Приложение: Program records; type students=record; name:string[15]; {имя, задаем 15 символов)} last_name:string[20]; {фамилия, задаем 20 символов)} Otchestvo:string[20]; Birthday:... {А вот отсюда начиная я незнаю...как что сделать...}

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

Отвечает: Boriss Здравствуйте, Jason! Ну вот где-то так, как в приложении Вид окна программы: Код: Студенты Выберите действие: 0 - Выход 1 - Ввод с клавиатуры 2 - Вся информация 3 - Информация о тех, у кого день рождения в данном месяце 4 - Информация о юбелярах 5 - Сортировка по возрасту 6 - Сохранить в файл students.dat 7 - Прочитать из файла students.dat ──────────────────────────────────────────────────────γ 2;───── Из файла students.dat добавлено записей 2 ──────────────────────────────────────────────────────────── Нажмите любую клавишу Буде что непонятно - спрашивайте Приложение: uses DOS, CRT; CONST lenName = 15; lenLastName = 20; lenOtchestvo = 20; FileName : String = 'students.dat'; TYPE {Реализую в виде связанного списка} TOne = record name : string[lenName]; last_name: string[lenLastName]; Otchestvo: string[lenOtchestvo]; Birthday : DateTime; end; POneStudent = ^TOneStudent; TOneStudent = record One : TOne; next: POneStudent; end; function LeadingZerou(src: Integer): string; {Для вывода дней и месяцев из одного числа добавляет впереди ноль} var s: String; begin Str(src, s); if length(s) = 1 then s := '0'+s; LeadingZerou := s end; function Exists(r: POneStudent; Info: TOne): Boolean; var p: POneStudent; begin Exists := FALSE; if r = nil then Exit; {Немедленный выход из подпрограммы} p := r; while p <> nil do begin if (p^.One.name = Info.name) and (p^.One.last_name = Info.last_name) and (p^.One.Otchestvo = Info.Otchestvo) then begin Exists := TRUE; Break {Выход из цикла и из подпрограммы} end; p := p^.next end; end; procedure Add(var r:POneStudent; Info: TOne); var p: POneStudent; begin if Exists(r, Info) then begin WriteLn(Info.name,' ', Info.last_name,' ', Info.Otchestvo, ' уже имеется в базе данных.'); Exit end; if r = NIL then begin {Список пустой} New(r); r^.Next := NIL; r^.One.name := Info.name; r^.One.last_name := Info.last_name; r^.One.Otchestvo := Info.Otchestvo; r^.One.Birthday := Info.Birthday; end else begin {Ищем конец списка} p:=r; while p^.next <> NIL do p:=p^.next; New(p^.next); p^.next^.Next := NIL; p^.next^.One.name := Info.name; p^.next^.One.last_name := Info.last_name; p^.next^.One.Otchestvo := Info.Otchestvo; p^.next^.One.Birthday := Info.Birthday; end; end; function InputAndAdd(var r: POneStudent): Integer; var t: TOne; s: String; w: Word; begin InputAndAdd := 0; WriteLn('Ввод пустой строки или нуля при вводе числа = отказ от ввода'); Write('Введите фамилию студента: '); ReadLn(s); if s='' then Exit; t.name := copy(s, 1, lenName); Write('Введите имя студента: '); ReadLn(s); if s='' then Exit; t.last_name := copy(s, 1, lenLastName); Write('Введите отчество студента: '); ReadLn(s); if s='' then Exit; t.Otchestvo := copy(s, 1, lenOtchestvo); if Exists(r, t) then begin WriteLn('Информация о ',t.name,' ', t.last_name,' ',t.Otchestvo,' уже имеется в базе данных'); Exit; end; repeat Write('Введите день рождения: '); {$I-} ReadLn(w); {$I+} until (IOresult = 0) and (w <= 31); if w=0 then Exit; t.Birthday.day := w; repeat Write('Введите месяц рождения (номер месяца): '); {$I-} ReadLn(w); {$I+} until (IOresult = 0) and (w <= 12); if w=0 then Exit; t.Birthday.month := w; repeat Write('Введите год рождения: '); {$I-} ReadLn(w); {$I+} until (IOresult = 0) and (w <= 2000); if w=0 then Exit; t.Birthday.year := w; Add(r, t); InputAndAdd := 1 end; procedure Free(var r: POneStudent); var p: POneStudent; begin while r <> nil do begin p:= r^.Next; Dispose(r); r := p end end; function ReadFromFile(var r: POneStudent; aFileName: String): Integer; {Число добавленных записей} var f: File of TOne; t: TOne; count: Integer; begin ReadFromFile := 0; Assign(f, aFileName); {$I-} Reset(f); {$I+} if IOResult <> 0 then begin {WriteLn('Не могу открыть файл ', aFileName);} Exit end; count:=0; While NOT EOF(f) do begin {$I-} Read(f, t); {$I+} if IOResult = 0 then begin if NOT Exists(r, t) then begin inc(count); Add(r, t); end end else WriteLn('Ошибка чтения'); end; Close(f); ReadFromFile := count; end; function SaveToFile(r: POneStudent; aFileName: String): Integer; {Возвращает число сохраненных записей ВСЕГДА ЗАМЕНЯЕТ файл, если он был} var f: File of TOne; p: POneStudent; count : Integer; begin SaveToFile := 0; if r = nil then Exit; Assign(f, aFileName); {$I-} Rewrite(f); {$I+} if IOResult <> 0 then begin WriteLn('Невозможно создать файл ',aFileName); SaveToFile:= 0; Exit end; count := 0; p := r; while p <> nil do begin Write(f, p^.One); inc(count); p:= p^.next end; Close(f); SaveToFile := count end; procedure PrintOne(p: POneStudent); begin if p = nil then Exit; WriteLn(p^.One.name:lenName,' ', p^.One.last_name:lenLastName,' ', p^.One.otchestvo:lenOtchestvo,' ', LeadingZerou(p^.One.Birthday.day),'.', LeadingZerou(p^.One.Birthday.month),'.', p^.One.Birthday.year:4); end; function PrintAll(r: POneStudent): Integer; {сколько найдено} var p: POneStudent; count : Integer; begin PrintAll := 0; if r = nil then Exit; p := r; count := 0; while p <> nil do begin PrintOne(p); p := p^.next; inc(count) end; PrintAll := count end; function PrintByMonth(r: POneStudent; m: Word): Integer; const months: Array[1..12] of string = (' январе ',' феврале ',' марте ',' апреле ',' мае ', ' июне ',' июле ',' августе ',' сентябре ',' октябре ', ' ноябре ',' декабре '); var p: POneStudent; count: Integer; {Чтоб вывести сообщение если нет} begin count := 0; PrintByMonth := 0; if m > 12 then begin WriteLn('Месяца с таким номером ',m,' нет.'); Exit end; if r <> nil then begin p:=r; while p <> nil do begin if p^.One.Birthday.month = m then begin if count = 0 then WriteLn('В месяце',months[m],'родились:'); inc(count); PrintOne(p); end; p := p^.next; end; end; if count = 0 then WriteLn('В',months[m],'никто не родился.'); PrintByMonth := count; end; function PrintInThis(r: POneStudent):Integer; var y, m, d, w: Word; begin GetDate(y, m, d, w); PrintInThis := PrintByMonth(r, m); end; function PrintAnniversary(r: POneStudent): Integer; var y, m, d, w: Word; p: POneStudent; count: Integer; begin PrintAnniversary := 0; if r = nil then exit; GetDate(y, m, d, w); p := r; count := 0; while p <> nil do begin w := y - p^.One.birthday.year; if (w mod 5 = 0) then begin {Те, что делятся нацело на 5} if count = 0 then WriteLn('В ',y,' юбилеи у:'); inc(count); PrintOne(p) end; p := p^.next end; { if count = 0 then WriteLn('В этом году (',y,') нет юбилеев.');} PrintAnniversary := count; end; function Sort(var r: POneStudent): Integer; var p, p1, p_min: POneStudent; t: TOne; age, age_min, y, m, d, dw: Word; {Для простоты не учитываю месяц. Возвращает число обменов} begin GetDate(y, m, d, dw); p:=r; d:=0; {Число обменов} while p <> nil do begin p_min := p; age_min := y - p_min^.One.Birthday.year; {Считаем, что это мин. возраст} {теперь по остальным} p1 := p^.next; while p1 <> nil do begin age := y - p1^.One.Birthday.Year; if age < age_min then p_min := p1; p1 := p1^.next; end; if (p <> p_min) then begin t := p^.One; p^.One := p_min^.One; p_min^.One := t; inc(d) end; p:= p^.next; end; Sort := d; end; procedure Menu; const chExit = '0'; chInput = '1'; chPrintAll = '2'; chBirthdays = '3'; chAnniversary = '4'; chSort = '5'; chSaveToFile = '6'; chReadFromFile= '7'; var choice : char; root : POneStudent; unsaved: Boolean; {файл, что есть несохраненные данные} buf : Integer; begin unsaved := FALSE; root := nil; repeat ClrScr; WriteLn('Студенты'); WriteLn('Выберите действие:'); WriteLn('0 - Выход'); WriteLn('1 - Ввод с клавиатуры'); WriteLn('2 - Вся информация'); WriteLn('3 - Информация о тех, у кого день рождения в данном месяце'); WriteLn('4 - Информация о юбелярах'); WriteLn('5 - Сортировка по возрасту'); WriteLn('6 - Сохранить в файл ',FileName); WriteLn('7 - Прочитать из файла ',FileName); WriteLn('------------------------------------------------------------'); choice := ReadKey; Case choice of chExit, #27:begin if unsaved then begin Write('В базе данных имеются несохраненные данные'); Write(' Сохранить? (Y/N)'); if ReadKey in ['Y', 'y', 'Н', 'н'] then SaveToFile(root, FileName); end; Exit; end; chInput: begin ClrScr; if InputAndAdd(root) <> 0 then unsaved := True; end; chPrintAll: begin ClrScr; if PrintAll(root) = 0 then WriteLn('База данных пуста.'); end; chBirthdays: begin ClrScr; PrintInThis(root); end; chAnniversary: begin ClrScr; if PrintAnniversary(root) = 0 then WriteLn('Нет юбилеев'); end; chSort : begin buf := Sort(root); WriteLn('Число сортировок ', buf); if buf <> 0 then unsaved := TRUE end; chSaveToFile: WriteLn('В файл ',FileName,' сохранено записей ', SaveToFile(root, FileName)); chReadFromFile: begin buf := ReadFromFile(root, FileName); WriteLn('Из файла ',FileName,' добавлено записей ', buf); if buf <> 0 then unsaved := TRUE; end; end; WriteLn('------------------------------------------------------------'); WriteLn('Нажмите любую клавишу'); ReadKey until FALSE; {Бесконечный цикл} Free(root); {Очистка памяти} end; BEGIN Menu; END. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 13.05.2009, 14:33 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 249101 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: За помощь естественно 5!!! Комментарии излишни, Борис молодец!;)

Вопрос № 166.903

Помогите пожалуйста с задачкой.Бьюсь третий день - всё никак. © Цитата: Ввести с клавиатуры квадратную матрицу X (M,M) (M<=10).Создать файл F1 следующим образом:сначала записать в него элементы главной диагонали,затем побочной,затем по строкам все остальные элементы матрицы,в конец файла записать сумму всех элементов матрицы.Выдать на печать матрицу в виде таблицы и файл F1.

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Hahhaha! Программа в приложении. Про тип файла у вас ничего нет в задании, поэтому создаю обычный текстовый. Вопросы в мини-форум. Приложение: program Matrica; uses crt; const MaxM=10; var F1: text; {файл} X: array [1..MaxM,1..MaxM] of integer; {матрица} M,i,j: byte; {размер матрицы и счетчики} FileName,tmp: string; {имя файла и временная строка для печати} summ:integer; {сумма элементов матрицы} begin clrscr; write('Введите размерность матрицы M<=',MaxM,':'); M:=0; while (M<=0) or (M>MaxM) do readln(M); { Вводим матрицу с клавиатуры } for i:=1 to M do for j:=1 to M do begin write('Введите X(',i,',',j,')='); readln(X[i,j]); end; write('Введите имя файла F1:'); readln(FileName); assign(F1,FileName); rewrite(F1); { Запишем файл по заданию попутно считаем сумму элементов } summ:=0; { Сначала элементы главной диагонали } for i:=1 to M do begin write(F1,X[i,i],' '); summ:=summ+X[i,i]; end; writeln(F1); { Затем побочной } for i:=1 to M do begin write(F1,X[i,M+1-i],' '); summ:=summ+X[i,M+1-i]; end; writeln(F1); { Потом остальные элементы } for i:=1 to M do begin for j:=1 to M do { Проверяем не принадлежит ли элемент одной из диагоналей } { и если не принадлежит - то записываем его в файл } if (j<>i) and (j<>M+1-i) then begin write(F1,X[i,j],' '); summ:=summ+X[i,j]; end; writeln(F1); end; { Если M нечетно, то главная и побочная диагонали будут иметь один общий элемент соответсвенно он будет просуммирован дважды, поэтому его нужно в этом случае вычесть } if odd(M) then summ:=summ-X[M div 2+1,M div 2+1]; writeln(F1,summ); close(F1); { Выводим на экран матрицу ... } clrscr; for i:=1 to M do begin for j:=1 to M do write(X[i,j]:6); writeln; end; writeln; { ... и файл } reset(F1); while not(eof(F1)) do begin readln(F1,tmp); writeln(tmp); end; readln; end.

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

Вопрос № 166.908

Уважаемые эксперты!! напишите программу: Найти произведение двух двумерных массивов А и В, если массив А имеет размерност n ×x m, а В - m × n. Укажите размерность результирующего массива и правило нахождения элемента с индексами i и j.

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Иоганн Фауст! Посмотрите по поиску ответ (второе задание) на вопрос 166492 Полностью аналогично вашему вопросу. В приложении - решение (Автор: Пупорев Юрий Борисович) : Размерность получающегося массива - n X n Приложение: uses crt; const n=5; m=7; var a:array[1..n,1..m] of real; b:array[1..m,1..n] of real; c:array[1..n,1..n] of real;{размер полученной матрицы=кол.стр. 1й*кол.стлбц. 2й} i,j,p:integer; begin clrscr; randomize; writeln('Матрица А:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=10*random; write(a[i,j]:4:1); end; writeln; end; writeln('Матрица B:'); for i:=1 to m do begin for j:=1 to n do begin b[i,j]:=10*random; write(b[i,j]:4:1); end; writeln; end; for p:=1 to n do for j:=1 to n do begin c[p,j]:=0;{сначала элемент i,j=0} for i:=1 to m do begin c[p,j]:=c[p,j]+a[p,i]*b[i,j]; {перемножаем элементы строк 1й матрицы на соответствующие элементы соответствующих столбцов 2й и суммируем} end; end; writeln('Матрица C=A*B:'); for i:=1 to n do begin for j:=1 to n do write(c[i,j]:7:1); writeln; end; readln end.

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

© 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