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.