Анкетные данные на абитуриентов в конце методического пособия. const text1='Год рождения.';

Текст программы:

program menu;

uses crt,dos;

const text1='Год рождения..........';

text2='Год окончания школы...';

text3=' Оценки в атестате';

text4='Метематика............';

text5='Физика................';

text6='Русский язык..........';

text7=' Оценки на вступительных экзаменах';

text8='Нуждается в общежитии';

text9='Не нуждается в общежитии';

type data=record

fio:string[30];

godr,godo:integer;

ates:record

mat,fiz,rus:integer;

end;

haus:boolean;

ekz:record

mat,fiz,rus:integer;

end;

end;

filetype=file of data;

var stu:data;

files,filetemp:file of data;

name,path,namefile:string;

keys:char;

menuunit:byte;

rec,position,freeunit:integer;

quit,openfile:boolean;

procedure sortirovka;

var a,b,c:filetype;

z:integer; {для подсчета числа серий}

eor:boolean; {индикатор конца серии}

procedure copys(var x,y:filetype);

var buf,buf1:data;

begin

read(x,buf);write(y,buf);

if eof(x) then eor:=true

else begin

{заглядываем вперед}

read(x,buf1);

{возвращаемся на исходную запись}

seek(x,filepos(x)-1);

if keys='1' then eor:=copy(buf1.fio,1,1)<copy(buf.fio,1,1);

if keys='2' then eor:=buf1.godr<buf.godr;

if keys='3' then eor:=buf1.godo<buf.godo;

end;

end;

procedure copyrun(var x,y:filetype);

{переписать серии из x в y}

begin

repeat

copys(x,y);

until eor;

end;

procedure mergerun;

{слияние серий из А и В в С}

var bufa,bufb:data;

begin

repeat

read(a,bufa);seek(a,filepos(a)-1);

read(b,bufb);seek(b,filepos(b)-1);

if keys='1'then if copy(bufa.fio,1,1)<copy(bufb.fio,1,1)

then begin;copys(a,c);if eor then copyrun(b,c);end

else begin;copys(b,c);if eor then copyrun(a,c);end;

if keys='2'then if bufa.godr<bufb.godr

then begin;copys(a,c);if eor then copyrun(b,c);end

else begin;copys(b,c);if eor then copyrun(a,c);end;

if keys='3'then if bufa.godo<bufb.godo

then begin;copys(a,c);if eor then copyrun(b,c);end

else begin;copys(b,c);if eor then copyrun(a,c);end;

until eor

end;

procedure distribute; {из С в А и В}

begin

reset(c);rewrite(a);rewrite(b);

repeat

copyrun(c,a);

if not eof(c) then copyrun(c,b);

until eof(c);

close(a);close(b);close(c);

end;

procedure merge;

begin

reset(a);reset(b);rewrite(c);

while (not eof(a))and(not eof(b)) do

begin

mergerun;z:=z+1;

end;

while not eof(a) do begin;copyrun(a,c);z:=z+1;end;

while not eof(b) do begin;copyrun(b,c);z:=z+1;end;

close(a);close(b);close(c);

end;

begin {main}

close(files);

assign(c,namefile);

assign(b,'c:\file2');

assign(a,'c:\file3');

repeat

distribute;z:=0;

merge;

until z=1;

erase(a);erase(b);

reset(files)

end;

procedure intemp;

begin

reset(files);rewrite(filetemp);

repeat read(files,stu);write(filetemp,stu);until eof(files);

reset(filetemp);rewrite(files);

end;

procedure outtextmenu(nmenu:byte;invert:boolean);

begin

window(30,nmenu+7,43,nmenu+7);

if invert then begin textbackground(2);textcolor(0);end

else begin textbackground(0);textcolor(15);end;

case nmenu of

1:write('Открыть ');

2:write('Создать ');

3:write('Поиск ');

4:write('Добавить ');

5:write('Удалить ');

6:write('Корректировка');

7:write('Просмотр ');

8:write('Сортировка ');

9:write('Выход ');

end;

end;

procedure reader;

begin

writeln(' Вводим данные об абитуриентах');

writeln(' Фамилия Имя Отчество');readln(stu.fio);

write(text1);readln(stu.godr);

write(text2);readln(stu.godo);

writeln(text3);

write(text4);readln(stu.ates.mat);

write(text5);readln(stu.ates.fiz);

write(text6);readln(stu.ates.rus);

writeln('Нуждается ли в общежитии (1-да/2-нет)');

keys:=readkey;if keys='1' then stu.haus:=true

else stu.haus:=false;

writeln(text7);

write(text4);readln(stu.ekz.mat);

write(text5);readln(stu.ekz.fiz);

write(text6);readln(stu.ekz.rus);

end;

function outfile:boolean;

begin

if fsearch(namefile,'')='' then begin;

outfile:=true;

namefile:='**********';

end

else outfile:=false;

end;

procedure cls;

begin

window(1,1,80,25);textcolor(15);textbackground(0);clrscr;

nosound;

end;

procedure sort;

begin

window(1,1,39,6);textcolor(0);textbackground(14);clrscr;

nosound;

writeln(' Сортировка');

writeln('1-по Фамилие');

writeln('2-по Году рождения');

writeln('3-по Году поступления');

writeln('4-Выход');

repeat

keys:=readkey;

if keys='1' then begin sortirovka;keys:='4';end;

if keys='2' then begin sortirovka;keys:='4';end;

if keys='3' then begin sortirovka;keys:='4';end;

until keys='4';

cls;writeln('Фамилия Имя Отчество');

end;

procedure startmenu;

label ex;

begin

if not openfile then goto ex;

reset(files);

rec:=0;

while not eof(files) do begin read(files,stu);rec:=rec+1;end;

ex:window(1,1,80,25);textcolor(15);textbackground(0);clrscr;

writeln('Рабочий файл:',namefile,', записей в файле:',rec);

for menuunit:=1 to 9 do outtextmenu(menuunit,false);

end;

procedure koreckt;

var zamena:data;

begin

window(1,1,39,22);textcolor(0);textbackground(14);clrscr;

nosound;

reader;

zamena:=stu;

intemp;

freeunit:=1;

while not eof(filetemp) do

begin

read(filetemp,stu);

if freeunit=position then write(files,zamena)

else write(files,stu);

freeunit:=freeunit+1;

end;

cls;writeln('Фамилия Имя Отчество');

end;

procedure delet;

begin

intemp;

freeunit:=1;

while not eof(filetemp) do

begin

read(filetemp,stu);

if position=freeunit then rec:=rec-1

else write(files,stu);

freeunit:=freeunit+1;

end;

if position=rec+1 then begin position:=position-1;if position=0 then position:=1;end;

end;

procedure lookmenu;

label ex;

const fiounit=20;

begin

if not(openfile) or (rec=0) then goto ex;

if menuunit=3 then position:=freeunit

else position:=1;

writeln('Фамилия Имя Отчество');

repeat

freeunit:=1;

reset(files);while not(freeunit=position) do begin read(files,stu);freeunit:=freeunit+1;end;

window(40,7,80,20);textcolor(3);textbackground(0);clrscr;

read(files,stu);

writeln(' ',stu.fio);

writeln(text1,stu.godr);

writeln(text2,stu.godo);

writeln(text3);

writeln(text4,stu.ates.mat);

writeln(text5,stu.ates.fiz);

writeln(text6,stu.ates.rus);

writeln(text7);

writeln(text4,stu.ekz.mat);

writeln(text5,stu.ekz.fiz);

writeln(text6,stu.ekz.rus);

if stu.haus then writeln(text8)

else writeln(text9);

window(1,3,39,3+fiounit);clrscr;

freeunit:=1;

reset(files);while not(freeunit=position) do begin read(files,stu);freeunit:=freeunit+1;end;

while not eof(files)and not(freeunit=position+fiounit) do

begin

read(files,stu);

if (position)=freeunit then

begin

textcolor(0);

textbackground(4);

writeln(freeunit,'.',stu.fio);

textcolor(15);

textbackground(0);

end

else writeln(freeunit,'.',stu.fio);

freeunit:=freeunit+1;

end;

while not(freeunit=position+fiounit) do

begin

writeln(freeunit,'.........................');

freeunit:=freeunit+1;

end;

window(1,25,80,25);textcolor(0);textbackground(2);

write('| Esc-выход | Delete-удалить | Enter-изменить | End-сортировка |');

keys:=readkey;

sound(2000);

quit:=false;

if keys=#79 then begin sort;end;

if keys=#72 then begin position:=position-1;if position=0 then position:=1;end;

if keys=#80 then begin position:=position+1;if position=(rec+1) then position:=rec;end;

if keys=#83 then delet;

if keys=#13 then koreckt;

nosound;

until (keys=#27)or(rec=0);

ex:end;

procedure creat;

begin

cls;

path:=path+name+'\';

write('Введите имя создаваемого файла ',path);

readln(name);

namefile:=path+name+'.dat';

if openfile then close(files);

assign(files,namefile);

rewrite(files);

close(files);

end;

procedure lookdir;

var f:searchrec;

recdir:integer;

attr:byte;

begin

cls;position:=1;path:='c:\';

repeat

freeunit:=1;recdir:=0;

window(30,1,60,21);textcolor(15);textbackground(0);clrscr;

writeln(path);writeln;

FindFirst(path+'*',Directory,f);

while doserror=0 do

begin

recdir:=recdir+1;

if position+20>=recdir then if position=recdir then begin

textcolor(0);textbackground(15);

writeln(f.name);

textcolor(15);textbackground(0);

name:=f.name;attr:=f.attr;

end

else if position <recdir then writeln(f.name);

findnext(f);

end;

FindFirst(path+'*.dat',AnyFile-Directory,f);

while doserror=0 do

begin

recdir:=recdir+1;

if position+20>=recdir then if position=recdir then begin

textcolor(0);textbackground(15);

writeln(f.name);

textcolor(15);textbackground(0);

name:=f.name;attr:=f.attr;

end

else if position <recdir then writeln(f.name);

findnext(f);

end;

window(1,25,80,25);textcolor(0);textbackground(2);

write('| Esc-Выход | Insert-Выбрать каталог |');

keys:=readkey;

sound(2000);

quit:=false;

if keys=#82 then if ((attr=48)or(attr=16))and not((name='.')or(name='..'))then begin creat;quit:=true;end;

if keys=#72 then begin position:=position-1;if position=0 then position:=1;end;

if keys=#80 then begin position:=position+1;if position=(recdir+1) then position:=recdir;end;

if keys=#13 then if (attr=48)or(attr=16) then if (name='..')or(name='.') then begin

repeat

delete(path,length(path),1);

until '\'=copy(path,length(path),1);

position:=1;

end

else begin path:=path+name+'\';position:=1;end

else begin quit:=true;namefile:=path+name;end;

if keys=#27 then quit:=true;

nosound;

until quit;

if not(keys=#27) then

begin

openfile:=true;

assign(files,namefile);

end;

quit:=false;

end;

procedure find;

label ex;

var finfio:string[30];

begin

if not openfile then goto ex;

write('Введите Ф.И.О.:');

readln(finfio);

reset(files);

freeunit:=1;

while not eof(files) do

begin

read(files,stu);if stu.fio=finfio then begin clrscr;lookmenu;goto ex;end;

freeunit:=freeunit+1;

end;

ex:end;

procedure add;

label ex;

begin

if not openfile then goto ex;

reset(files);rewrite(filetemp);

while not eof(files) do begin read(files,stu);write(filetemp,stu);end;

reset(filetemp);rewrite(files);

while not eof(filetemp) do begin read(filetemp,stu);write(files,stu);end;

repeat;

reader;

write(files,stu);

clrscr;

writeln(' Данные об абитуриенте введены');

writeln('1-Добавить данные');

writeln('2-Выход');

writeln(' (нажмите 1 или 2)');

keys:=readkey;

until keys='2';

ex:end;

begin

namefile:='**********';rec:=0;openfile:=false;

assign(filetemp,'c:\temp.dat');

startmenu;

repeat

outtextmenu(menuunit,true);

keys:=readkey;

sound(2000);

quit:=false;

if keys=#72 then begin outtextmenu(menuunit,false);menuunit:=menuunit-1;if menuunit=0 then menuunit:=9;end;

if keys=#80 then begin outtextmenu(menuunit,false);menuunit:=menuunit+1;if menuunit=10 then menuunit:=1;end;

nosound;

if keys=#13 then begin

cls;

case menuunit of

1:lookdir;

2:lookdir;

3:find;

4:add;

5:lookmenu;

6:lookmenu;

7:lookmenu;

8:lookmenu;

9:quit:=true;

end;

startmenu;

end;

until quit;

if openfile then close(files);

rewrite(filetemp);close(filetemp);erase(filetemp);

end.

Распечатка результатов работы программы после выполнения пунктов меню 4,5,6 и 8:

Фамилия Имя Отчество   1.Бажин Никита Андреевич 2.Гаспер Валентина Александровна 3.Демидов Иван Сергеевич 4.Егорова Пелагея Луповна 5.Еговцев Иван Артурович Бажин Никита Андреевич 6.Кирьянов Антон Алексеевич Год рождения......……..…1983 7.Корягина Нина Плахова Год окончания школы…..2000 8.Маслова Нина Михайловна Оценки в атестате 9.Молчановский Ильнар Ирекович Метематика.....………......5 10.Мельникова Лариса Анатольевна Физика..............…………..5 11.Михайлов Артём Егорович Русский язык........………4 12.Малышев Василий Владимирович Оценки на вступительных экзаменах 13.Ползунова Елена Андреевна Метематика..........……….5 14.Смирнов Никита Владимирович Физика..............…………...4 15.Созинов Алексей Петрович Русский язык........……….4 16.Синилов Сергей Иванович Нуждается в общежитии 17.Теплоухов Юрий Леонидович 18.Токарева Надежда Александровна 19.Тихонов Сергей Геннадьевич 20.Шарапов Евгений Владимирович     | Esc-выход | Delete-удалить | Enter-изменить | End-сортировка |

Варианты заданий.

1) Книги в библиотеке. Содержится следующая информация: Название книги, автор, год издания, тираж, инвентарный номер.

2) Автостоянка. Сведения о прибывающих машинах: Марка, номер, ФИО владельца, дата прибытия на стоянку, время нахождения на стоянке.

3) Фирма. Анкетные данные сотрудников: ФИО, год поступления в фирму, дата рождения, оклад, адрес.

4) Аптека. Номенклатура товаров: Название лекарства, внутреннее/наружное, дата изготовления, срок годности, ФИО кассира (продавца).

5) Фильмы. Список содержит следующую информацию: название фильма, режиссёр, год выпуска, продолжительность в минутах, студия, где снимался фильм.

6) Отдел “Соки-воды”. Информация об имеющихся в продаже напитках: название, фирма-изготовитель, калорийность, ёмкость посуды, цена.

7) Фотография. Журнал записей содержит информацию: номер заказа, дата приёма заказа, размер фотографий, ФИО фотографа, ФИО заказчика, цена заказа.

8) Гостиница. Содержится следующая информация о проживающих в гостинице: ФИО клиента, номер комнаты, дата въезда, количество дней проживания, стоимость суточного проживания (зависит от категории номера).

9) Продажа видео-аудио кассет. Хранится следующая информация: Марка кассеты, фирма-изготовитель, название альбома, время записи (например: 60, 90 минут).

10) Магазин “Мебель”. Номенклатура товаров: Наименование изделия, дата изготовления, цена продажи, завод-изготовитель, цвет, название материала из которого изготовлено изделие.

11) Магазин “Продукты”. Ведётся учёт товаров: Наименование товара, поступившее количество (штук), количество проданного (штук), цена продажи, дата изготовления, дата реализации.

12) Магазин “Одежда”. Ведётся учёт товаров: Наименование изделия, цена за штуку, количество полученное, продано, размер, цвет, вид ткани.

13) Детский сад. Информация о дошкольниках: ФИО ребёнка, дата рождения, адрес проживания, уровень подготовки (значение 1-5).

14) Отдел “Бытовая техника”. Содержится следующая информация: Наименование товара, фирма изготовитель, серийный номер, цвет, срок гарантии.

15) Киоск “Цветы”. Ведётся учёт проданных цветов: Название цветка, цена за штуку, цвет, комнатное/садовое.

16) Ремонт часов. Имеется следующая информация: Марка часов, ФИО часовщика, дата приёмки, дата выхода из ремонта, стоимость ремонта.

17) Картинная галерея. Ведётся учёт экспонатов галереи: Наименование картины, художник, инвентарный номер, год создания картины, реставратор, цена.

18) Магазин “Ткани”. Ведётся учёт товаров: Наименования ткани, фабрика -изготовитель, полученное количество (в метрах), цена за метр, ширина ткани.

19) Телефонная станция. Имеется информация: ФИО абонента, номер телефона, адрес, тариф со звонка.

20) Речное пароходство. Информация о судах: Название парохода, маршрут, водоизмещение, количество пассажирских мест, класс судна (пароход, теплоход, трамвайчик).

21) Ателье. Имеется следующая информация: номер заказа, наименование изделия, количество ткани для изделия, стоимость заказа, дата приёма заказа, дата изготовления.

22) Дворец творчества юных. Хранится следующая информация: Название кружка, год создания кружка, ФИО преподавателя, количество человек в кружке, средний возраст занимающихся.

23) Почта. Ведётся учёт предоставляемых услуг: Категория отправления (посылка, бандероль, телеграмма, письмо, перевод), вес или количество букв, стоимость услуги, дата отправления, время отправления.

24) Стройматериалы. Ведётся учёт продажи материалов: Наименование материала, завод-изготовитель, цвет, тонкость помола, цена за единицу.

Анкетные данные абитуриентов: