Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

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

Лучшие эксперты данной рассылки

Орловский Дмитрий Статус: Профессор Рейтинг: 4134 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 2645 ∙ повысить рейтинг »

Абаянцев Юрий Леонидович aka Ayl Статус: Профессионал Рейтинг: 2329 ∙ повысить рейтинг »

Вопрос № 182351: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: помогите с программой нужно Создать список для детского сада (поля: фамилия, адрес, возраст, группа,) В программе должны быть предусмотрены процедуры: ɨ...

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
помогите с программой
нужно Создать список для детского сада (поля: фамилия, адрес, возраст, группа,)

В программе должны быть предусмотрены процедуры:
 Формирование списка (Добавление записи в конце списка;)
 Добавление записи в начало списка;
 Вывод всего списка (просмотр)
 Добавление записей после определенной записи;
 Добавление записей перед определенной записью;
 Сохранение в файле
 Вывод из файла на экран
 Вывод из файла в список
 Удаление первой записи;
 Удаление последней записи;
 Удаление указанной записи;
 Удаление записи перед определенной записью (предыдущий объект);
 Удаление записи после определенной записи (сл. Объект);
 Удаление всего списка

Отправлен: 01.03.2011, 18:30
Вопрос задал: Посетитель - 349343 (Посетитель)
Всего ответов: 1
Страница вопроса »

Приложение:
program Q182351; uses Crt; type tList=^dList; dList=record n:string[20];{} p:string[50];{} a:byte;{} g:string[5];{} b:tList; end; var a:tList; b:file of dList; c:dList; d,e:tList; z:char; {служебные сообщения} procedure PAK; begin writeln(\'Press any key ...\'); ReadKey; end; procedure ErrorFound; begin writeln(\'Error not Fount\'); PAK; end; procedure ErrorFuel; begin writeln(\'Error memory fuel\'); PAK; end; procedure ErrorEmpty; begin writeln(\'Error memory empty\'); PAK; end; {считываем данные об одном элементе} procedure GetData; begin write(\'Enter Name:\'); readln(c.n); write(\'Enter Ago:\'); readln(c.a); write(\'Enter Group:\'); readln(c.g); write(\'Enter Post:\'); readln(c.p); end; {загружаем данные в список} procedure LoadData; begin d^.n:=c.n; d^.g:=c.g; d^.a:=c.a; d^.p:=c.p; end; {поиск элемента с нужным именем} procedure FindData(var p:tList); begin write(\'Get name:\'); readln(c.n);{считываем имя элемента} p:=a;{в начало списка} while(p^.n<>c.n)and(p^.b<>nil)do p:=p^.b;{поиск указателя} end; {поиск предыдущего элемента} procedure FindList(p:tList;var o:tList); begin o:=a;{в начало списка} while(o^.b<>p)and(o^.b<>nil)do o:=o^.b;{поиск указателя} end; {вывод файла на экран} procedure FileView; begin assign(b,\'myData.dat\');{подключаем файл} reset(b);{для чтения} while not(eof(b))do begin read(b,c);{считываем один элемент} writeln(\'data: \',c.n,\' - \',c.p,\' - \',c.a,\' - \',c.g);{выводим на экран} end; close(b);{закрываем файл} end; {загружаем данные в список} procedure FileList; begin if a<>nil then ErrorFuel{список уже загружен} else begin a:=nil; assign(b,\'myData.dat\');{подлючаем файл} reset(b);{для чтения} while not(eof(b))do begin read(b,c);{читываем одну запись} new(d);{резервируем память} LoadData;{загружаем данные} d^.b:=a;{переключаем связи} a:=d;{начало элемента} end; close(b);{закрываем файл} end; end; {запись в файл} procedure DataFile; begin if a=nil then ErrorEmpty{список пустой} else begin assign(b,\'myData.dat\');{подключаем файл} rewrite(b);{для записи} d:=a;{указатель в начало списка} repeat c.a:=d^.a;{загружаем данные} c.g:=d^.g; c.p:=d^.p; c.n:=d^.n; write(b,c);{записываем в файл} d:=d^.b;{переходим к следующему элементу} until d=nil; close(b);{закрываем файл} end; end; {создаем список} procedure CreateList; begin if a<>nil then ErrorFuel{список уже создан} else begin a:=nil;{начало списка} repeat writeln; GetData;{получаем данные} if c.n[1]<>\'.\' then begin new(d);{резервируем память} LoadData;{загружаем данные} d^.b:=a;{перенаправляем связи} a:=d;{начало списка} end; until c.n[1]=\'.\'; end; end; {вывод списка на экран} procedure ViewList; begin if a=nil then ErrorEmpty{память пуста} else begin d:=a;{в начало списка} while d<>nil do begin writeln(\'data: \',d^.n,\' - \',d^.p,\' - \',d^.a,\' - \',d^.g);{вывод одного элемента} d:=d^.b;{переходим на следующий} end; end; PAK;{} end; {добавление в начало списка} procedure AddFirst; begin new(d);{резервируем память} GetData;{получаем данные} LoadData;{загружаем данные} d^.b:=a;{перенаправляем связи} a:=d;{новый указатель начала списка} end; {добавляем в конец списка} procedure AddLast; begin GetData;{получаем данные} e:=a;{указатель в начало списка} while e^.b<>nil do e:=e^.b;{поиск конца списка} new(d);{новый элемент} LoadData;{загружаем память} d^.b:=e^.b;{перенаправляем связи} e^.b:=d;{перенаправляем связи} end; {добавлем после нужного элемента} procedure AddAfter; begin FindData(d);{поиск нужного элемента} if d^.n<>c.n then ErrorFound{ошибка поиска} else begin GetData;{получаем данные} new(d);{резервируем память} LoadData;{загружаем данные} d^.b:=e^.b;{перенаправляем связи} e^.b:=d;{перенаправляем связи} end; end; {вставляем перед нужным элементом} procedure AddBefore; begin FindData(d);{поиск нужного элемента} if d^.n<>c.n then ErrorFound{ошибка поиска} else if e=a then AddFirst{добавлем элемент в начало скписка} else begin FindList(d,e);{ищем указатель на нужный элемент} GetData;{получаем данные} new(d);{резирвируем память} LoadData;{загружаем память} d^.b:=e^.b;{перенаправляем связи} e^.b:=d;{перенаправляем связи} end; end; {удаляем первый элемент в списке} procedure KillFirst; begin d:=a;{указатель на первый элемент} a:=a^.b;{начало списка - следующий элемент} dispose(d);{освобождаем память} end; {удаляем последний элемент в списке} procedure KillLast; begin d:=a;{запоминаем начало списка} repeat e:=d;{запоминаем указатель} d:=d^.b;{преходим к следующему} until d^.b=nil; e^.b:=nil;{исключаем из списка} dispose(d);{освобождаем память} end; {удаляем предыдущий элемент} procedure KillBefore; begin FindData(d);{поиск нужного элемента} if (d^.n<>c.n)or(d=a) then ErrorFound{элемент не найден} else begin FindList(d,e);{поиск указателя на удаляемый элемент} if e=a then KillFirst{удаляемый элемент в начале списка} else begin d:=e;{запоминаем указатель} FindList(d,e);{поиск указателя на удалямый элемент} e^.b:=d^.b;{перенаправляем связи} dispose(d);{освобождаем память} end; end; end; {удаляем следующий элемент} procedure KillAfter; begin FindData(d);{поиск нужного элемента} if (d^.n<>c.n)and(d^.b<>nil) then ErrorFound{элемент отсутствует} else begin e:=d;{запоминаем указатель} d:=d^.b;{следующий элемент} e^.b:=d^.b;{перенапрямляем связи} dispose(d);{освобождаем память} end; end; {удаляем текущий элемент} procedure KillCurrent; begin FindData(d);{поиск текущего элемента} if d^.n<>c.n then ErrorFound{ошибка нет элемента} else begin FindList(d,e);{поиск указателя на текущий элемент} e^.b:=d^.b;{исключаем из списка} dispose(d);{освобождаем память} end; end; {очмстка всего списка} procedure KillAll; begin if a=nil then ErrorEmpty{ошибка память свободна} else repeat KillFirst;{удалить один элемент в начале списка} until a=nil; end; begin a:=nil;{указатель на начало списка} repeat while KeyPressed do ReadKey;{очмстка буфера ввода} writeln; writeln(\'Main menu\'); writeln(\'q-Exit to system\');{выход} writeln(\'w-Load to List\');{Вывод из файла в список} writeln(\'e-Load to View\');{Вывод из файла на экран} writeln(\'r-Create List\');{Формирование списка} writeln(\'t-Add first\');{Добавление записи в начало списка;} writeln(\'y-Add last\');{Добавление записи в конце списка;} writeln(\'u-Add after\');{Добавление записей после определенной записи;} writeln(\'i-Add before\');{Добавление записей перед определенной записью;} writeln(\'o-Save List\');{Сохранение в файле} writeln(\'p-View List\');{Вывод всего списка} writeln(\'a-Kill first\');{Удаление первой записи;} writeln(\'s-Kill last\');{Удаление последней записи;} writeln(\'d-Kill current\'); {Удаление указанной записи;} writeln(\'f-Kill before\');{Удаление записи перед определенной записью} writeln(\'g-Kill after\');{Удаление записи после определенной записи} writeln(\'h-Kill all\');{Удаление всего списка} z:=ReadKey; case z of \'w\':FileList; \'e\':FileView; \'r\':CreateList; \'t\':AddFirst; \'y\':AddLast; \'u\':AddAfter; \'i\':AddBefore; \'o\':DataFile; \'p\':ViewList; \'a\':KillFirst; \'s\':KillLast; \'d\':KillCurrent; \'f\':KillBefore; \'g\':KillAfter; \'h\':KillAll; end; until z=\'q\'; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич (Модератор)
Ответ отправлен: 07.03.2011, 17:06
Номер ответа: 266129
Украина, Киев
Тел.: +38-097-238-60-03
Адрес: Украина, Киев

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 266129 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »