Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 30.11.2013, 22:02   #1 (permalink)
andrew_ryaba
Новичок
 
Регистрация: 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
andrew_ryaba вне форума   Ответить с цитированием

Старый 30.11.2013, 22:02
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

По данной тематике есть и другие темы

Нужна программа для записи с нескольких web-камер
Нужна программа для записи на минусовки

Старый 01.12.2013, 11:33   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,298
Сказал(а) спасибо: 290
Поблагодарили 512 раз(а) в 169 сообщениях
Репутация: 93301
По умолчанию

Цитата:
Сообщение от andrew_ryaba Посмотреть сообщение
Я попытался сделать хотя бы только пункт а, но из этого ничего не вышло - не работает...
Так, ну поработал я в Вашей программой. Кое-что исправил, кое-что убрал, кое-что добавил. Но не всё. В частности:
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
2. Вот Вы в процедурах пишете:
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.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 01.12.2013, 22:33   #3 (permalink)
andrew_ryaba
Новичок
 
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Спасибо Вам огромное! Вы проделали такую колоссальную работу, я даже не ожидал, что почти всю программу мне напишут...
Немного подправил под требования преподавателя.
А про диаграмму - буду пока думать...
andrew_ryaba вне форума   Ответить с цитированием
Старый 01.12.2013, 22:38   #4 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,298
Сказал(а) спасибо: 290
Поблагодарили 512 раз(а) в 169 сообщениях
Репутация: 93301
По умолчанию

Цитата:
Сообщение от andrew_ryaba Посмотреть сообщение
Спасибо Вам огромное! Вы проделали такую колоссальную работу, я даже не ожидал, что почти всю программу мне напишут...
Немного подправил под требования преподавателя.
А про диаграмму - буду пока думать...
Удачи!______
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 23:03.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.