Возможности полученного

Программного продукта

Таким образом мы построили гибкую модель базы данных, в которой легко создать нужный запрос, данные представлены в удобном для пользователя виде. Интерфейс программы построен без излишков и настроен на максимальное удобство пользователя. Программа позволяет заполнять базу данных одновременно несколькими пользователями, каждый из которых будет заполнять свою таблицу. Так как программа работает с динамическими списками, то она быстра и позволяет избежать избыточности данных в таблицах.

 

Текст программы Kurs.pas

 

program Delphins;

uses crt,tips;

var names,namer:string[10];

key,kr:char;

tek,i,j,izm:integer;

exist,vfile,issor:boolean;

nast:pered;

temr,tt1,tt2,tt3,tt4:cc;

outf:file of tabl2;

 

procedure menus(m:pered;max:byte); {Вывод меню}

begin

clrscr;

For i:=1 to max do begin

if i=1 then begin

textcolor(1); gotoxy(9,2); write(m.st[i]);

end

else begin

if i=2 then textcolor(9)

else textcolor(3);

gotoxy(8,i+3);write(m.st[i]);

end;

end;

end;

 

procedure krutis; {Звездочка рядом с активным элементом}

begin

textcolor(14);

if kr='/' then kr:='-'

else if kr='-' then kr:='\'

else if kr='\' then kr:='|'

   else kr:='/';

gotoxy(6,tek+3);write(kr);

textcolor(3);

end;

 

procedure ramka(ch:char); {перемещение указателя}

begin

gotoxy(6,tek+3);Writeln(' ');

textcolor(3);gotoxy(8,tek+3);write(nast.st[tek]);

if ch='+' then tek:=tek+1

else tek:=tek-1;

if tek=1 then tek:=nast.m

else if tek=nast.m+1 then tek:=2;

key:=#0;

textcolor(9);gotoxy(8,tek+3);write(nast.st[tek]);

krutis;

end;

 

procedure tabl11(t:integer;rab:cc); {Вывод таблицы в файл}

var ooutf:text;

tem:cc;

begin

clrscr;

writeln('Введите имя файла');

readln(names);

assign(ooutf,names);

rewrite(ooutf);

writeln(ooutf,menu2.st[t]);

writeln(ooutf,'+--------------------------------------------------------------------------+');

writeln(ooutf,'¦',mm[t-1,1]:14,'¦',mm[t-1,2]:14,'¦',mm[t-1,3]:14,'¦',mm[t-1,4]:14,'¦',mm[t-1,5]:14,'¦');

writeln(ooutf,'+--------------+--------------+--------------+--------------+--------------¦');

tem:=rab;

while tem<>nil do

begin

writeln(ooutf,'¦',tem^.tabl.t1:14,'¦',tem^.tabl.t2:14,'¦',tem^.tabl.t3:14,'¦',tem^.tabl.t4:14,

'¦',tem^.tabl.t5:14,'¦');

tem:=tem^.sled;

end;

writeln(ooutf,'+--------------------------------------------------------------------------+');

close(ooutf);

nast:=menu1;

menus(nast,nast.m);

tek:=2;

end;

 

 

procedure tabl1(t:integer;rab:cc;yd:boolean); {Вывод таблицы на экран}

var tem:cc;

begin

clrscr;

writeln(menu2.st[t]);

writeln('+--------------------------------------------------------------------------+');

writeln('¦',mm[t-1,1]:14,'¦',mm[t-1,2]:14,'¦',mm[t-1,3]:14,'¦',mm[t-1,4]:14,'¦',mm[t-1,5]:14,'¦');

writeln('+--------------+--------------+--------------+--------------+--------------¦');

tem:=rab;

while tem<>nil do

begin

writeln('¦',tem^.tabl.t1:14,'¦',tem^.tabl.t2:14,'¦',tem^.tabl.t3:14,'¦',tem^.tabl.t4:14,

'¦',tem^.tabl.t5:14,'¦');

tem:=tem^.sled;

end;

writeln('+--------------------------------------------------------------------------+');

if not yd then begin

readln;

nast:=menu1;

menus(nast,nast.m);

tek:=2;

end;

yd:=false;

end;

 

procedure sort(iz,t:integer; var rab:cc); {Сортировка по полю}

var po:integer;

te1,te2,tem:cc;

str1,str2:string;

ttrtt:tabl2;

begin

tabl1(tek,rab,true);

writeln('Введите номер столбца по которому надо отсортировать данные');

readln(po);

te1:=rab;

while te1<>nil do begin

te2:=te1^.sled;

while te2<>nil do begin

case po of

   1:begin str1:=te1^.tabl.t1; str2:=te2^.tabl.t1; end;

   2:begin str1:=te1^.tabl.t2; str2:=te2^.tabl.t2; end;

   3:begin str1:=te1^.tabl.t3; str2:=te2^.tabl.t3; end;

   4:begin str1:=te1^.tabl.t4; str2:=te2^.tabl.t4; end;

   5:begin str1:=te1^.tabl.t5; str2:=te2^.tabl.t5; end;

end;

if str1>str2 then begin

   ttrtt:=te1^.tabl;

   te1^.tabl:=te2^.tabl;

   te2^.tabl:=ttrtt;

end;

te2:=te2^.sled;

end;

te1:=te1^.sled;

end;

tabl1(tek,rab,false);

end;

 

procedure obrabotka(iz,t:integer; var rab:cc); {Обработка записей}

var dlud:string;

bis:boolean;

tems,temr,tem:cc;

begin

clrscr;

if iz=1 then begin     {добавление записи}

if rab<>nil then begin

  tem:=rab;

  while tem^.sled<>nil do tem:=tem^.sled;

  new(tem^.sled);

  tem:=tem^.sled;

end

else begin

  new(rab);

  tem:=rab;

end;

writeln(mm[t,1]);readln(tem^.tabl.t1);

writeln(mm[t,2]);readln(tem^.tabl.t2);

writeln(mm[t,3]);readln(tem^.tabl.t3);

writeln(mm[t,4]);readln(tem^.tabl.t4);

writeln(mm[t,5]);readln(tem^.tabl.t5);

tem^.sled:=nil;

tem:=rab;

izm:=0;

nast:=menu1;

menus(nast,nast.m);

tek:=2; iz:=0;

end

else if iz=2 then begin  {Удаление записи}

tems:=rab;

tabl1(tek,rab,true);

writeln('Введите уникальный номер'); readln(dlud);

bis:=true;

if rab^.tabl.t1 = dlud then begin

rab:=rab^.sled;

bis:=false;

end

else begin

while tems<>nil do begin

   if tems^.sled^.tabl.t1=dlud then begin

     tem:=tems^.sled;

     tems^.sled:=tems^.sled^.sled;

     dispose(tem);

     bis:=false;

     break;

   end;

   tems:=tems^.sled;

end;

end;

if bis then writeln('Данной записи не обнаруженно');

nast:=menu1;

menus(nast,nast.m);

tabl1(tek,rab,false);

izm:=0;

tek:=2;

end

else if iz=3 then begin {изменение данных}

tems:=rab;

tabl1(tek,rab,true);

writeln('Введите уникальный номер'); readln(dlud);

bis:=true;

while tems<>nil do begin

   if tems^.tabl.t1=dlud then begin

     writeln(mm[t,1]);readln(tems^.tabl.t1);

     writeln(mm[t,2]);readln(tems^.tabl.t2);

     writeln(mm[t,3]);readln(tems^.tabl.t3);

     writeln(mm[t,4]);readln(tems^.tabl.t4);

     writeln(mm[t,5]);readln(tems^.tabl.t5);

     break;

   end;

   tems:=tems^.sled;

end;

if bis then writeln('Данной записи не обнаруженно');

nast:=menu1;

menus(nast,nast.m);

tabl1(tek,rab,false);

izm:=0; tek:=2;

end;

end;

 

procedure zapros(num:integer); {Запросы}

var str1,str2,str3:string;

tem1,tem2:cc;

nay:boolean;

zz:tabl2;

begin

clrscr;

nay:=false;

case num of

2:begin     {Найти оценку}

tem1:=tt1;

writeln('Введите фамилию'); readln(str1);

writeln('Введите название предмета');readln(str2);

while tem1<>nil do begin

if tem1^.tabl.t2=str1 then begin str1:=tem1^.tabl.t1; break; end;

tem1:=tem1^.sled;

end;

tem1:=tt2;

while tem1<>nil do begin

if tem1^.tabl.t2=str2 then begin str2:=tem1^.tabl.t1; break; end;

tem1:=tem1^.sled;

end;

tem1:=tt4;

while tem1<>nil do begin

if ((tem1^.tabl.t5=str2) and (tem1^.tabl.t4=str1)) then begin

   textcolor(red);

   writeln('Оценка этого студента-',tem1^.tabl.t2);

   nay:=true; break;

end;

tem1:=tem1^.sled;

  end;

end;

3:begin               {Преподаватель}

writeln('Выедите название предмета');

readln(str1);

tem1:=tt2;

while tem1<>nil do begin

if tem1^.tabl.t2=str1 then begin str1:=tem1^.tabl.t3; break; end;

tem1:=tem1^.sled;

end;

tem1:=tt3;

while tem1<>nil do begin

if tem1^.tabl.t1=str1 then begin

   textcolor(red);

   writeln('Преподаватель-');

   with tem1^.tabl do write(' ',t2,', ',t3,', ',t4);

   nay:=true; break;

end;

tem1:=tem1^.sled;

end;

end;

4:begin               {Найти размер стипендии}

writeln('Введите фамилию студента');

readln(str1);

tem1:=tt1;

while tem1<>nil do begin

if tem1^.tabl.t2=str1 then begin

   textcolor(red);

   writeln('Стипендия-',tem1^.tabl.t5);

   nay:=true; break;

end;

tem1:=tem1^.sled;

end;

end;

5:begin           {Вывод всех студентов с избранной оценкой}

writeln('Введите оценку');

readln(str1);

tem1:=tt4; tem2:=tt1;

textcolor(red);

while tem1<>nil do begin

if tem1^.tabl.t2=str1 then begin

   str2:=tem1^.tabl.t4;

   while tem2<>nil do begin

     if tem2^.tabl.t1=str2 then begin

       with tem2^.tabl do

          writeln('Студент-',t3,' ',t4,' ',t2);

       nay:=true;

     end;

     tem2:=tem2^.sled;

   end;

end;

tem2:=tt1; tem1:=tem1^.sled;

end;

end;

6:begin       {Найти дату сдачи предмета}

writeln('Введите название предмета');

readln(str1);

tem1:=tt2;

while tem1<>nil do begin

if tem1^.tabl.t2=str1 then begin str1:=tem1^.tabl.t1; break; end;

tem1:=tem1^.sled;

end;

tem1:=tt4;

while tem1<>nil do begin

if tem1^.tabl.t5=str1 then begin

   textcolor(red);

   writeln('Дата сдачи-',tem1^.tabl.t3);

   nay:=true;

end;

tem1:=tem1^.sled;

end;

end;

end;

textcolor(red);

if not nay then writeln('Запрос невыполним');

textcolor(3); readln;

nast:=menu1; menus(nast,nast.m);

tek:=2;

end;

 

procedure writetip(temr:cc);

begin

clrscr;

 write('Введите имя файла');

 writeln('в котором хотите сохранить данные');

 readln(names);

 for i:=1 to 4 do begin

if temr<>nil then begin temr:=nil; end;

case i of

1:begin temr:=tt1; namer:='1'+names; end;

2:begin temr:=tt2; namer:='2'+names; end;

3:begin temr:=tt3; namer:='3'+names; end;

4:begin temr:=tt4; namer:='4'+names; end;

end;

assign(outf,namer); rewrite(outf);

while temr<>nil do begin

write(outf, temr^.tabl);

temr:=temr^.sled;

end;

 CLOSE(outf);

 end;

 nast:=menu1; menus(nast,nast.m); tek:=2;

end;

 

procedure readtip(temr:cc);

var tems:cc;

begin

clrscr;

 write('Введите имя файла');

 writeln('из которого надо взять данные'); readln(names);

for i:=1 to 4 do begin

if temr<>nil then begin temr:=nil; end;

if tems<>nil then begin tems:=nil; end;

case i of

1:begin new(tt1); temr:=tt1; namer:='1'+names; end;

2:begin new(tt2); temr:=tt2; namer:='2'+names; end;

3:begin new(tt3); temr:=tt3; namer:='3'+names; end;

4:begin new(tt4); temr:=tt4; namer:='4'+names; end;

end;

assign(outf,namer); reset(outf);

if eof(outf) then begin

case i of

1:begin dispose(tt1);tt1:=nil;end;

2:begin dispose(tt2);tt2:=nil;end;

3:begin dispose(tt3);tt3:=nil;end;

4:begin dispose(tt4);tt4:=nil;end;

end;

end

else begin

tems:=temr;

while temr<>nil do begin

if eof(outf) then break;

read(outf,temr^.tabl);

if eof(outf) then break;

new(temr^.sled);

temr:=temr^.sled;

end;

temr^.sled:=nil;

 case i of

1:tt1:=tems;

2:tt2:=tems;

3:tt3:=tems;

4:tt4:=tems;

 end;

end;

CLOSE(outf);

 end;

 nast:=menu1; menus(nast,nast.m); tek:=2;

end;

 

procedure main;

begin

key:=#0;

if nast.st[1]=menu1.st[1] then begin {Если меню - основное}

case tek of

2:readtip(temr);

3:writetip(temr);

4,5,7:begin

nast:=menu2; menus(nast,nast.m);

if tek=7 then issor:=true;

if tek=4 then vfile:=true

else if tek=5 then vfile:=false;

tek:=2;

end;

6:begin

nast:=menu3; menus(nast,nast.m); tek:=2;

end;

8:begin

nast:=menu4; menus(nast,nast.m); tek:=2;

end;

9: begin

exist:=true;

end;

end;

end

 

else if nast.st[1]=menu3.st[1] then begin {Если текущее меню-menu3}

case tek of

2,3,4:begin

izm:=tek-1;

nast:=menu2; menus(nast,nast.m); tek:=2;

end;

5:begin

nast:=menu1;

menus(nast,nast.m); tek:=2;

end;

end;

end

 

else if nast.st[1]=menu4.st[1] then begin {Если текущее меню-menu4}

case tek of

2,3,4,5,6:zapros(tek);

7:begin

nast:=menu1;

menus(nast,nast.m); tek:=2;

end;

end;

end

 

else if nast.st[1]=menu2.st[1] then begin {Если текущее меню-menu2}

if izm>0 then begin

   case tek of

     2:obrabotka(izm, tek-1,tt1);

     3:obrabotka(izm, tek-1,tt2);

     4:obrabotka(izm, tek-1,tt3);

     5:obrabotka(izm, tek-1,tt4);

   6:begin

   nast:=menu1; menus(nast,nast.m); izm:=0; tek:=2;

   end;

   end;

end

else if issor=true then begin

   issor:=false;

   case tek of

   2:sort(izm, tek-1,tt1);

   3:sort(izm, tek-1,tt2);

   4:sort(izm, tek-1,tt3);

   5:sort(izm, tek-1,tt4);

   6:begin

   nast:=menu1; menus(nast,nast.m); izm:=0; tek:=2;

   end;

   end;

end

 

else begin

   case tek of

   2:if vfile then tabl11(tek,tt1)

     else tabl1(tek,tt1,false);

   3:if vfile then tabl11(tek,tt2)

     else tabl1(tek,tt2,false);

   4:if vfile then tabl11(tek,tt3)

     else tabl1(tek,tt3,false);

   5:if vfile then tabl11(tek,tt4)

     else tabl1(tek,tt4,false);

   6:begin

   nast:=menu1; menus(nast,nast.m); izm:=0; tek:=2;

   end;

   end;

end;

end;

end;

 

begin

clrscr;

textBackground(black);

tek:=2;  kr:='-';

exist:=false;

nast:=menu1; menus(nast,nast.m);

while 1>0 do begin

if keypressed then key:=readkey;

case key of

#80:ramka('+');

#72:ramka('-');

#27:exist:=true;

#13:main;

end;

if exist then exit;

krutis;

end;

end.

Текст модуля Tips.pas

Unit tips;

interface

type

pered=record

st:array[1..12] of string;

m:byte;

end;

 

tabl2=record

t1,t2,t3,t4,t5:string[12];

end;

cc=^tab;

tab=record

tabl:tabl2;

sled:cc;

end;

 

var

menu1,menu2,menu3,menu4:pered;

mm:array[1..5,1..5] of string[50];

implementation

begin

with menu1 do begin

st[1]:='БАЗА ДАННЫХ';

st[2]:='Загрузка';

st[3]:='Сохр. в тип. файл';

st[4]:='Сохр. в текст. файл';

st[5]:='Просмотр';

st[6]:='Корректировка';

st[7]:='Сортировка';

st[8]:='Запросы';

st[9]:='Выход';

m:=9;

end;

mm[1,1]:='Студенческий';

mm[1,2]:='Фамилия';

mm[1,3]:='Имя';

mm[1,4]:='Отчество';

mm[1,5]:='Стипендия';

mm[2,1]:='Код предмета';

mm[2,2]:='Название';

mm[2,3]:='Код преподав.';

mm[2,4]:='Время учебы';

mm[2,5]:='Курс';

mm[3,1]:='Код преподав.';

mm[3,2]:='Фамилия';

mm[3,3]:='Имя';

mm[3,4]:='Отчество';

mm[3,5]:='Начало работы';

mm[4,1]:='Код сдачи';

mm[4,2]:='Оценка';

mm[4,3]:='Дата сдачи';

mm[4,4]:='Студенческий';

mm[4,5]:='Код предмета';

 

with menu2 do begin

st[1]:='ПРОСМОТР';

st[2]:='Студенты';

st[3]:='Предметы';

st[4]:='Преподаватели';

st[5]:='Оценки';

st[6]:='Выход';

m:=6;

end;

with menu3 do begin

st[1]:='КОРРЕКТИРОВКА';

st[2]:='Добавление';

st[3]:='Удаление';

st[4]:='Изменение';

st[5]:='Выход';

m:=5;

end;

with menu4 do begin

st[1]:='ЗАПРОСЫ';

st[2]:='Найти оценку';

st[3]:='Кто принимал экзамен';

st[4]:='Найти размер стипендии';

st[5]:='Вывод по оценке';

st[6]:='Дата сдачи экзамена';

st[7]:='Выход';

m:=7;

end;

end.