Разработка процедур
Рассмотрим процедуры пользователя.
Заставка программы – procedure zastavka
Данная процедура осуществляет вывод заставки. Сначала устанавливаем цвет фона, выводим желтым надпись «Kursovaya rabota». Далее сверху и снизу закрашиваем экран желтым (аналог шторы). После этого в цикле выводим увеличивающиеся от центра прямоугольники. После чего снова появляется запись «Kursovaya rabota», фамилия, имя и номер группы автора программы. Далее появляются закрашенные разноцветные круги. Далее программа ждет нажатия клавиши пользователем, после чего выходит конечная заставка информационной системы с приглашением нажать Enter. После нажатия клавиши Enter появляется главное меню программы.
Текст процедуры
procedure zastavka;
const
zag = 'Kursovaya rabota';
im = 'VUZ';
var
gd,gm,i,j,x,y,n,r:integer;
begin
gd:=detect;
initgraph(gd,gm,'D:\TP\BGI');
setbkcolor(0);
setcolor(14); settextstyle(0,0,4);
outtextXY(50,trunc(getmaxY/2)-20,zag);
delay(500);
setfillstyle(1,yellow); setcolor(yellow);
x:=getmaxX div 2; y:=getmaxY div 2;
for i:=1 to y do
begin
bar(0,0,getmaxX,i);
bar(0,getmaxY-i,getmaxX,getmaxY);
delay(25);
end;
for j:=1 to 3 do
begin
cleardevice; setbkcolor(0);
setlinestyle(random(4),1,random(4));
for i:=1 to 30 do
begin
setcolor(yellow);
rectangle(x-i*10,y-i*5,x+i*10,y+i*5);
delay(25); cleardevice;
end;
end;
outtextXY(50,100,zag); delay(1500);
setlinestyle(0,1,3);
rectangle(x-160,y-50,x+150,y+50);
settextstyle(0,0,2);
outtextXY(x-130,y-40,'KUTUMOV MIHAIL');
outtextXY(x-130,y,'Gruppa 11.03.01');
outtextXY(x-130,y+20,'Radiotehnika');
outtextXY(x-30,y+200,'2015');
delay(1500);
for i:=1 to 100 do
begin
x:=random(getMaxX);
y:=random(GetMaxY);
n:= random(15);
setcolor(n); circle(x,y,2); delay(30);
end;
repeat until keypressed;
delay(500); cleardevice;
for i:=1 to 50 do
begin
x:=random(getmaxX); y:=random(getmaxY); r:=random(240);
setcolor(Random(16));
circle(x,y,r);
end;
delay(1500); cleardevice;
setbkcolor(0); settextstyle(0,0,6);
outtextXY(70,10,'InfoSystem');
settextstyle(0,0,7);
for i:=1 to 3 do
begin
outtextXY(570,50+70*i,copy(im,i,1));
delay(1500);
end;
settextstyle(0,0,2);
outtextXY(trunc(getmaxX/2)-50,trunc(getmaxY/2)+20,'Press Enter');
repeat until keypressed and (ReadKey=#13);
closegraph;
end;
Создание базы данных – procedure create
Данная процедура предназначена для ввода данных. Открывается файл, связанный с файловой переменной f, для записи. инициализируем переменную i, присваивая ей значение 0. В цикле repeat… until происходит ввод данных. Выводится заголовок страницы 'Create Base' и приглашение ввести данные. Так как данные вводятся и в другой процедуре, то для компактности программы создана еще одна процедура vvod, в которой непосредственно и осуществляется ввод.
Текст процедуры
procedure create;
var i,j,ans:byte;
begin
rewrite(f); i:=0;
repeat
clrscr; i:=i+1;
gotoXY(35,2); textcolor(red);
writeln('Create Base');
gotoXY(1,3); writeln('Input record number ',i);
vvod;
write(f,person); writeln;
write('0 - exit, 1 - continue ');
readln(ans);
until ans=0;
close(f);
end;
Дополнение базы данных – procedure add
Данная процедура предназначена для дополнения в базу новых данных. Открывается файл с помощью процедуры reset. С помощью процедуры seek(f,filesize(f)) переходим в конец файла. В переменную i записываем номер последней записи. В цикле repeat… until происходит ввод данных. Выводится заголовок страницы 'Add record' и приглашение ввести данные. Так как данные вводятся и в другой процедуре, то для компактности программы создана еще одна процедура vvod, в которой непосредственно и осуществляется ввод.
Текст процедуры
procedure add;
var
ans,n:byte;
i:integer;
begin
clrscr;
reset(f);
seek(f,filesize(f));
i:=filepos(f);
repeat
clrscr; i:=i+1;
textcolor(red);
gotoXY(35,2);
writeln('Add record');
textcolor(yellow);
gotoXY(1,3);
writeln('Input record number ',i);
vvod;
write(f,person); writeln;
write('0 - exit, 1 - continue ');
readln(ans); writeln;
until ans=0;
close(f);
end;
Вывод базы данных на экран – procedure display
Данная процедура осуществляет вывод данных из типизированного файла на экран. Файл открывается для чтения процедурой reset. Условие not eof(f) будет иметь значение true (истина) пока не достигнут конец файла. И пока конец файла не достигнут из него считывается очередная запись, результат заносится в переменную person и на экран. После вывода всех записей из файла на экране появляется строка 'Press any key for Main Menu ', т.е. приглашение нажать любую клавишу для выхода в главное меню.
Текст процедуры
procedure display;
var i:integer;
begin
clrscr;
i:=0;
reset(f);
hat(4,'Display Base');
textcolor(white);
while not eof(f) do
begin
i:=i+1; read(f,person);
rezult(i+4,i,person);
end;
writeln;
textcolor(red);
writeln ('Press any key for Main Menu ');
repeat until keypressed;
close(f);
end;
Вывод сотрудников заданной кафедры – procedure search_kafedra
Данная процедура предназначена для поиска всех сотрудников заданной кафедры. Файл открывается для чтения с помощью процедуры reset. В переменную s вводится с клавиатуры название кафедры, сотрудников которой надо вывести на экран. Условие not eof(f) будет иметь значение true (истина) пока не достигнут конец файла. И пока конец файла не достигнут из него считывается очередная запись, результат заносится в переменную person. При совпадении поля kafedra данной записи c введенным значением, на экран выводятся все поля данной записи. После первого же совпадения переменная b принимает значение true. После просмотра всего файла проверяется условие b=false, т.е. условие того, что не найдено ни одной записи с заданным названием кафедры. Тогда на экран выводится текст о том, что неверно задано название или нет данных в базе. В противном случае выводится количество сотрудников кафедры. После этого у пользователя появляется возможность повторить запрос. Для этого надо выбрать 1 и нажать Enter, при выборе 0 осуществляется выход в главное меню программы.
Текст процедуры
procedure search_kafedra;
var s:string;
b:boolean;
ans,i: byte;
begin
repeat
clrscr;
hat(6,'Spisok sotrudnikov kafedry');
b:=false;
gotoXY(5,4);
write('Input name of the kafedra ');
textcolor(white);
repeat
readln(s) until s<>'';
reset(f);i:=0;
textcolor(white);
while (not eof(f)) do
begin
read(f,person);
if person.kafedra=s then
begin
i:=i+1;
b:=true;
rezult(6+i,i,person);
end;
end;
textcolor(red);
writeln; writeln;
if b=false then writeln('INVALID NAME OR NAME WITH NO INFORMATION')
else
writeln('Kafedra ',s,' imeet sotrudnikov - ',i);
writeln;
write(' 0 - exit, 1 - continue: ');
readln(ans);
until ans=0;
close(f);
end;
Вывод всех профессоров ВУЗа – procedure all_professors
Данная процедура предназначена для поиска всех профессоров ВУЗа. Файл открывается для чтения с помощью процедуры reset. Условие not eof(f) будет иметь значение true (истина) пока не достигнут конец файла. И пока конец файла не достигнут из него считывается очередная запись, результат заносится в переменную person. При совпадении поля dolzhnost данной записи co значением константы p = 'Professor', на экран выводятся все поля данной записи. После первого же совпадения переменная b принимает значение true. После просмотра всего файла проверяется условие b=false, т.е. условие того, что не найдено ни одной записи с должностью профессора. Тогда на экран выводится текст о том, что в ВУЗе нет профессоров. После вывода данных на экране появляется строка 'Press any key for Main Menu ', т.е. приглашение нажать любую клавишу для выхода в главное меню.
Текст процедуры
procedure all_professors;
const p='Professor';
var b:boolean;
ans:byte;
i:integer;
begin
clrscr;
hat(4,'All Professors');
b:=false;
textcolor(white);
reset(f);
while (not eof(f)) do
begin
read(f,person);
if person.dolzhnost=p then
begin
i:=i+1;
b:=true;
rezult(5+i,i,person);
end;
end;
writeln;
textcolor(red);
if b=false then writeln('NO PROFESSORS IN VUZ');
writeln;
writeln('Press any key for Main Menu ');
repeat until keypressed;
close(f);
end;
Поиск самого старейшего преподавателя ВУЗа – procedure max_prep
Данная процедура предназначена для определения старейшего преподавателя ВУЗа. Файл открывается для чтения с помощью процедуры reset. Полагаем, что максимальный возраст преподавателя равен какому-то достаточно малому числу, например, положим max:=20. Условие not eof(f) будет иметь значение true (истина) пока не достигнут конец файла. И пока конец файла не достигнут из него считывается очередная запись, результат заносится в переменную person. Если данные поля age очередной записи person, считанной из файла, больше числа max, а поле dolzhnost не совпадает с d[5], т.е. должность человека не делопроизводитель, то полагаем, что max:=person.age. Также вводим еще одну переменную типа rec – maxperson, в которую записываем запись person, удовлетворяющую вышеописанным условиям. После просмотра всего файла в переменной maxperson сохраняются данные старейшего преподавателя и они выводятся на экран. После вывода данных на экране появляется строка 'Press any key for Main Menu ', т.е. приглашение нажать любую клавишу для выхода в главное меню.
Блок-схема 1. Алгоритм поиска старейшего преподавателя
Текст подпрограммы
procedure max_prep;
var ans, max: byte;
maxperson:rec;
begin
clrscr;
hat(4,'Oldest prepodavatel');
textcolor(white);
reset(f);
max:=20;
while (not eof(f)) do
begin
read(f,person);
if (person.age>max) and (person.dolzhnost<>d[5]) then
begin
max:=person.age;
maxperson:=person;
end;
end;
rezult(6,1,maxperson);
textcolor(red);
writeln;writeln;
writeln('Press any key for Main Menu ');
repeat until keypressed;
close(f);
end;
Сортировка сотрудников ВУЗа по возрастанию стажа работы – sort.
Данная процедура предназначена для сортировки сотрудников ВУЗа по возрастанию стажа работы.
Создаем дополнительный массив, куда будут заноситься записи.ю считанные из файла mass: array[1..100] of rec.
Размерность данного массива устанавливается достаточно большой, предполагая, что больше этого числа сотрудников быть не может. В данной базе положили это число равным 100.
Файл VUZ.DAT открывается для чтения с помощью процедуры reset(f), где f – файловая переменная, связанная с физическим файлом. Условие not eof(f) будет иметь значение true (истина) пока не достигнут конец файла. И пока конец файла не достигнут из него считывается очередная запись, результат заносится в массив mass: read(f,buf); j:=j+1; mass[j]:=buf; где buf – дополнительная переменная типа rec.
После записи всех строк базы в созданный массив все данные находятся в оперативной памяти. Далее мы сортируем массив в оперативной памяти. После сортировки в переменной mass находятся отсортированные по возрастанию стажа работы записи типа rec. Осуществляем вывод всех компонентов массива на экран. После вывода данных на экране появляется строка 'Press any key for Main Menu ', т.е. приглашение нажать любую клавишу для выхода в главное меню.
Блок-схема 2. Алгоритм сортировки сотрудников по возрастанию стажа работы
Текст подпрограммы
procedure sort;
var
i, j, t: integer;
buf:rec;
mass: array[1..100] of rec;
begin
clrscr;
hat(4,'Sortirovka by Length of Work');
textcolor(white);
reset(f); j:= 0;
while not eof(f) do
begin
read(f,buf);
j:=j+1; mass[j]:=buf;
end;
t:=j;
for i:=1 to t do
for j:=t downto i+1 do
if mass[j-1].work > mass[j].work then
begin
buf:=mass[j-1];
mass[j-1]:=mass[j];
mass[j]:=buf;
end;
for j:=1 to t do rezult(5+j,j,mass[j]);
writeln; writeln;
textcolor(red);
writeln('Press any key for Main Menu ');
repeat until keypressed;
close(f);
end;
Основное меню программы – menu
Основное меню программы – это меню, которое появляется после заставки, и позволяет выбрать одну из возможностей работы с базой данных или выйти из программы.
В подпрограмме объявлена константа menu
menu: array[1..n] of string[25] = (' New Base ',' Add Record ',' Display ',' Search Kafedra',' All Professors',' Oldest Prepodavatel',' Sort by Length Of Work','Exit');
в которой записаны названия пунктов меню.
С помощью специальной подпрограммы display_menu, описанной в процедуре menu осуществляется вывод пунктов меню на экран. Далее в цикле repeat … until осуществляется считывание нажатой клавиши. Если код клавиши возвращает ноль, т.е. ch=chr(0), т.е. нажата одна из функциональных клавиш. В самом начале мы находимся на первом пункте меню, записываем это в переменную
number:=1.
Задаем цвет фона надписи, тем самым обозначая какой пункт меню является активным.
Далее осуществляем проверку кода нажатой клавиши.
Если код нажатой клавиши равен 80 (т.е. нажата стрелка вниз) и number<n=8 (т.е. мы не находимся на последнем пункте меню), то увеличиваем число number на единицу и закрашиваем фон следующего пункта меню.
Если код нажатой клавиши равен 72 (т.е. нажата стрелка вверх) и number>1 (т.е. мы не находимся в самом верхнем пункте меню), то уменьшаем число number на единицу и закрашиваем фон предыдущего пункта меню.
Если код нажатой клавиши равен 13 (т.е. нажата клавиша Enter) и мы находимся в номере меню, равном number, то выполняется та процедура, которая соответствует этому номеру.
Последний пункт меню – Exit, означающий выход из программы. Находясь в этом пункте меню и нажимая клавишу Enter, мы присваиваем переменной ch=chr(27) – Esape (код =27).
Программа заканчивает свою работу тогда, когда ch=chr(27).
Блок-схема 3. Блок-схема алгоритма menu
Текст процедуры
procedure menu;
const
n=8;
menu: array[1..n] of string[25] = (' New Base ',' Add Record ',' Display ',' Search Kafedra',' All Professors',' Oldest Prepodavatel',' Sort by Length Of Work','Exit');
var
number,x,y:integer;
ch:char;
procedure display_menu;
var i:integer;
begin
textbackground(0); clrscr;
gotoXY(35,2); textcolor(14);
writeln(main); textcolor(white);
for i:=1 to n do
begin
gotoXY(x,y+i-1); write(menu[i]);
end;
textbackground(4); textcolor(0);
gotoXY(x,y+number-1); write(menu[number]);
textbackground(0); textcolor(15);
end;
begin
number:=1; x:=25; y:=5;
textbackground(0); textcolor(15);
display_menu;
repeat
ch:=ReadKey;
if ch=chr(0) then
begin
ch:=ReadKey;
case ch of
chr(80):if number<N then
begin
gotoXY(x,y+number-1);
write(menu[number]);
inc(number);
textbackground(4);
textcolor(0);
gotoXY(x,y+number-1);
write(menu[number]);
textbackground(0);
textcolor(15);
end;
chr(72):if number>1 then
begin
gotoXY(x,y+number-1);
write(menu[number]);
dec(number);
textbackground(4);
textcolor(0);
gotoXY(x,y+number-1);
write(menu[number]);
textbackground(0);
textcolor(15);
end;
end;
end
else
if ch=chr(13) then
begin
case number of
1:create;
2:add;
3:display;
4:search_kafedra;
5:all_professors;
6:max_prep;
7:sort;
8:ch:=chr(27);
end;
display_menu;
end;
until ch=chr(27);
end;
Помимо основных процедур, рассмотренных выше, в программе присутствуют еще три процедуры: vvod, hat и result.
Процедура vvod предназначена для ввода значений в соответствующие поля записей. Так как эта операция осуществляется дважды – в процедуре create и в процедуре add, то она вынесена в отдельную процедуру.
Процедура hat предназначена для вывода заголовка и названий полей таблицы. Так как эти данные выводятся в каждом пункте меню, то эти действия вынесены в отдельную процедуру. В качестве параметров вводятся номер строки, в которую выводятся названия полей таблицы, и заголовок страницы-результата.
Процедура rezult предназначена для вывода результатов на экран. В качестве параметров передается номер строки для вывода, номер выводимой записи и сама запись.