30.11.2013, 22:02 | #1 (permalink) |
Новичок
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Программа на тему записи и процедуры
В банке данных о получении пособий на детей находятся три поля: 1-ое поле: ФИО рабочих 2-ое поле: количество детей 3-е поле: даты рождения (год, месяц, число) детей. Определить, сколько пособий на своих детей получает каждый рабочий (дети старше 18 лет пособие не получают). Определить рабочего, получающего максимальное пособие. С этой частью я справился, а вот дальше начинаются проблемы... Запрограммировать следующие процедуры и функции: а) поиск записи по двум любым полям, определенным в программе, б) вывод записи, в) добавление новой записи в конец файла, г) удаление записей по критерию, д) вывод файла, е) построение диаграммы по одному из полей записи. Я попытался сделать хотя бы только пункт а, но из этого ничего не вышло - не работает... [PASCAL]uses crt; const nowadays = 2013; n = 10; type datar = record den: 1..31; mes: 1..12; god: 1900..nowadays; end; rabotnic = record fio: string[40]; koldet: 1..10; data: array [1..10] of datar; end; var ftext: text; ftip: file of rabotnic; a, b: rabotnic; NameMax: string; i, k, pMax: Byte; p:boolean; procedure SearchFIO; var j: byte; x: string[40]; begin j := 0; Reset(ftip); writeln('vvedite familiyu, imya , otchestvo'); read(x); while not Eof(ftip) do begin read(ftip, b); if (b.fio = x) then begin writeln(b); Inc(j); end; end; if j = 0 then writeln('nichego ne naideno'); end; begin assign(ftext, 'record.txt'); assign(ftip, 'ftip.rec'); {$I-} reset(ftext); {$I+} {if IOResult <> 0 then begin writeln(' "record.txt" not found, press ENTER to continue..'); readln; exit; end;} pMax := 0; rewrite(ftip); while not eof(ftext) do with a do begin read(ftext, fio, koldet); for i := 1 to koldet do read(ftext, data[i].god, data[i].mes, data[i].den); readln(ftext); write(ftip, a); k := 0; for i := 1 to koldet do if (nowadays - data[i].god) < 18 then inc(k); writeln('Rabochiy ', fio:40, k, ' posobiy(a)'); if k > pMax then begin pMax := k; NameMax := fio; end; end; writeln('Max kol posobij u ', NameMax); ReadKey; repeat Window(1, 1, 80, 25); TextBackground(1); ClrScr; p:=false; writeln('1=poisk zapisi po fio'); writeln('2=poisk zapisi po kolichestvu posobiy'); writeln('3=vivod zapisi'); writeln('4=udalenie zapisey'); writeln('5=vivod tipizirovannogo faila'); writeln('6=postroit diagrammu'); writeln('7=dobavlenie novoy zapisi v file'); writeln('9=EXIT'); case ReadKey of '1': SearchFIO; { '2': ; '3': ; '4': ; '5': ; '6': ; '7': ;} '9': p:=true; end; until p; close(ftext); close(ftip); end.[/PASCAL] Проверял вот на этих данных: Ivanov Ivan Ivanych 2 2004 3 3 2005 5 5 Sidorov Semen Semenych 1 2000 4 4 Petrov Petr Petrovich 2 1990 12 3 1999 7 27 |
30.11.2013, 22:02 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
По данной тематике есть и другие темы Нужна программа для записи с нескольких web-камер Нужна программа для записи на минусовки |
01.12.2013, 11:33 | #2 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
1. Вывод файла - это как? Вывод записи - какой? Есть же пункты поиска, там и запись выводится. Заменил эти два пункта одним "Вывод записей". Выводится вся информация по семьям всех рабочих. 2. Что за "диаграмма"? В чем ее строить? Графика? Но какая? Borland? ABC? Delphi? И что должна показывать диаграмма? Пункт удалил. Кроме того, убрал эти CRT-шные рюшечки типа цвета и размера окна. Нужно будет - сами восстанавливайте. По мне, так дурь лишняя. Теперь об ошибках. 1. Вот Вы в исходном текстовом файле лепите в одну строку ФИО (string) и числовые данные. Такие строки, в принципе, обработать можно, но надо мало-мало на уши встать, объясняя транслятору, где, собственно, заканчивается строка и начинаются числа. Гораздо проще выделить ФИО в отдельную строку, тогда и проблем не будет, т.е. исходный файл примет вид: Код:
Ivanov Ivan Ivanych 2 2004 3 3 2005 5 5 Sidorov Semen Semenych 1 2000 4 4 Petrov Petr Petrovich 2 1990 12 3 1999 7 27 Var x:string; begin ... read(x); ... end. Грубейшая ошибка! Считывание строк с консоли осуществляется ТОЛЬКО оператором ReadLn, никаких Read!!! Запомните на будущее. Ну ладно, вот некий вариант, если поможет - буду рад. Естественно, оно отлажено и протестировано: Код:
uses crt; const nowadays = 2013; n = 10; type datar = record den: 1..31; mes: 1..12; god: 1900..nowadays; end; rabotnic = record fio: string; koldet: 1..10; data: array [1..10] of datar; end; var ftext: text; ftip: file of rabotnic; i,pMax: Byte; p: boolean; c:Char; procedure Vvod; var t:rabotnic; begin reset(ftext); rewrite(ftip); while not eof(ftext) do with t do begin readln(ftext, fio); read(ftext,koldet); for i:=1 to koldet do read(ftext, data[i].god, data[i].mes, data[i].den); readln(ftext); write(ftip, t); end; close(ftext); close(ftip); end; procedure WrInf(t:rabotnic); begin writeln('FIO: '+t.fio); writeln('Kolichestvo detey: ',t.koldet); write('data: '); for i:=1 to t.koldet do write(t.data[i].den,'.',t.data[i].mes,'.',t.data[i].god,' '); writeln; end; procedure SearchFIO; var j:byte; x:string; b:rabotnic; begin j:= 0; Reset(ftip); writeln('vvedite familiyu, imya , otchestvo'); readln(x); while not Eof(ftip) do begin read(ftip,b); if (b.fio=x) then begin WrInf(b); Inc(j); end; end; if j=0 then writeln('nichego ne naideno'); writeln; end; procedure DelRec; var j:byte; x:string; b:rabotnic; begin j:= 0; Rewrite(ftext); Reset(ftip); writeln('vvedite familiyu, imya , otchestvo'); readln(x); while not Eof(ftip) do begin read(ftip,b); with b do begin if (fio<>x) then begin Writeln(ftext,fio); Write(ftext,koldet,' '); for i:=1 to koldet do with data[i] do write(ftext,god,' ',mes,' ',den,' '); writeln(ftext); end else inc(j); end; end; Close(ftip); Close(ftext); Vvod; if j=0 then writeln('nichego ne naideno'); end; procedure AddRec; var b:rabotnic; x:string; Ndet,d,m:byte; y:word; begin Append(ftext); writeln('vvedite familiyu, imya , otchestvo'); readln(x); Writeln(ftext,x); Write('Vvedite kolichestvo detey: '); Readln(Ndet); Write(ftext,Ndet,' '); for i:=1 to Ndet do begin write('rebenok N',i,' (dd mm yyyy): '); readln(d,m,y); write(ftext,y,' ',m,' ',d,' '); end; writeln(ftext); Close(ftext); writeln; Vvod; end; procedure SearchNdet; var Ndet,j:byte; b:rabotnic; begin j:=0; Reset(ftip); write('vvedite kolichestvo detey '); readln(Ndet); while not Eof(ftip) do begin read(ftip, b); if (b.koldet=Ndet) then begin WrInf(b); Inc(j); end; end; if j=0 then writeln('nichego ne naideno'); writeln; end; Procedure MaxPos; var t:rabotnic; k:Byte; NameMax: string; begin reset(ftip); pMax:=0; repeat read(ftip,t); k:=0; for i:=1 to t.koldet do if (nowadays - t.data[i].god)<18 then inc(k); writeln('Rabochiy ', t.fio:40,' ',k, ' posobiy(a)'); if k>pMax then begin pMax:=k; NameMax:=t.fio; end; until EoF(ftip); Close(ftip); writeln('Max kol posobij = ',pMax,' u ', NameMax); end; Procedure GlobalInf; var t:rabotnic; begin reset(ftip); repeat read(ftip,t); WrInf(t); until EoF(ftip); Close(ftip); Writeln; end; begin ClrScr; assign(ftext, 'record.txt'); assign(ftip, 'ftip.rec'); Vvod; MaxPos; Repeat writeln; p:=false; writeln('1=poisk zapisi po fio'); writeln('2=poisk zapisi po kolichestvu detey'); writeln('3=vivod zapisey'); writeln('4=udalenie zapisey po FIO'); writeln('5=dobavlenie novoy zapisi v file'); writeln('6=EXIT'); c:=ReadKey; writeln; case C of '1': SearchFIO; '2': SearchNdet; '3': GlobalInf; '4': DelRec; '5': AddRec; '6': p:=true; end; Until p; end. |
|
01.12.2013, 22:33 | #3 (permalink) |
Новичок
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Спасибо Вам огромное! Вы проделали такую колоссальную работу, я даже не ожидал, что почти всю программу мне напишут...
Немного подправил под требования преподавателя. А про диаграмму - буду пока думать... |
01.12.2013, 22:38 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|