Курсовая работа: Разработка базы данных "Учащиеся"

user; {Выбор пользователя}

menus; {Открытие меню}

end.{Baza Dannyh}

(Листинг Unit программы)

{******************************************************************}

{ Zastavka - Процедура        заставки }

{ Makeramka - Рисование рамок }

{ Lines - Рисование линий }

{ Archieve - Процедура архива }

{ User - Процедура выбора пользователя }

{ Menus - Процедура меню }

{ Password - Процедура запроса пароля, требует только у Админа }

{******************************************************************}

Unit REGUNIT;

Interface

uses crt;

const

illcount=100;

NameProg='Baza dannyh';

PasswordX='password';

Line1='ННННННННННННННННННСННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН';

 mmenu:array [1..5] of string[16]=(' Novoe delo ',

' Архив... ',' Поиск... ',' Пользователь...',

' ‚Выход ');

menunew:array [1..2] of string[16]=(' ‘®еа ­Ёвм ',

' Ћв¬Ґ­ ');

menuarch:array [1..3] of string[16]=(' ‘®еа ­Ёвм ',

 ' ‡ Јаг§Ёвм ',' Ћв¬Ґ­ ');

 menufind:array [1..2] of string[16]=(' Ќ ©вЁ ',

' Ћв¬Ґ­ ');

menuuser:array [1..2] of string[40]=

(' Ђ¤¬Ё­Ёбва в®а ',

' Џ®«м§®ў вҐ«м ');

simvV : set of char =

['A'..'Z','a'..'z','0'..'9','_','\',':',

 '(',')','!','#','%','^','~','-','''','&','@'];

simvN : set of char = ['A'..'Z','a'..'z','Ђ'..'џ',' '..'п'];

simvD : set of char = ['0'..'9','.'];

simvDIG : set of char = ['0'..'9'];

krifind: array [1..8] of string[8]=('number','sur','name','otch',

'dateburn','surdoc','namedoc','otchdoc');

type

ill = record

number: integer;{­®¬Ґа Є ав®зЄЁ}

sur: string[20];{д ¬Ё«Ёп}

name: string[20];{Ё¬п}

otch: string[20];{®взҐбвў®}

dateburn: string[20];{¤ в ஦¤Ґ­Ёп}

surdoc: string[20];{д ¬Ё«Ёп ўа з }

namedoc: string[20];{Ё¬п ўа з }

otchdoc: string[20];{®взҐбвў® ўа з }

end;

masi = array[1..illcount] of ill;

fff = file of ill;

max = array[1..3,1..28] of integer;

var

pass, flag, open, admin: boolean;

m: max;

numb, numfind, illind, posx, simv, sim, i: integer;

tempmas: array[1..9] of string;

masill: masi;

fileill: fff;

Procedure menucl;

Procedure Screen(color:byte);

Function GotoCen(s:string):integer;

Procedure lines(color:byte);

Procedure space(n:byte);

Procedure clear;

Procedure MakeRamka(x0,y0:integer; s:string; x,y:integer;color,fon:byte);

Procedure field;

Procedure archieve;

Procedure menuarchh;

Procedure menunewkar;

Procedure menufinder;

Procedure user;

Procedure menus;

Procedure zastavka;

Procedure password;

Implementation

procedure menucl;

var

i:integer;

begin{menucl}

textbackground(blue);

for i:=1 to 20 do

begin

gotoxy(2,i+2);

writeln(' ');

end;

end;{menucl}

Procedure Screen(color:byte);

Var

i:integer;

begin{screen}

textbackGround(color);

for i:=1 to 25 do

writeln(' ');

gotoXY(1,1);

end;{screen}

Function GotoCen(s:string):integer;

begin{gotocen}

GotoCen:=(80-length(s)) div 2;

end;{gotocen}

Procedure lines(color:byte);

var

i:byte;

begin{lines}

textcolor(color);

gotoXY(gotocen(nameprog),1);writeln(NameProg);

write(line1);

for i:=3 to 25 do

begin

gotoxy(19,i);

write('і');

end;

textcolor(yellow);

end;{lines}

Procedure space(n:byte);

Var

i:byte;

begin{space}

for i:=1 to n do

write(' ');

end;{space}

Procedure Clear;

var

x,y:byte;

begin{clear}

textbackground(blue);

For y:=3 to 24 do

For x:=20 to 80 do

Begin

gotoxy(x,y);

write(' ');

end;

end;{clear}

Procedure MakeRamka(x0,y0:integer; s:string; x,y:integer;color,fon:byte);

var

i,j:integer;

begin {MakeRamka}

textbackground(fon);

textcolor(color);

gotoxy(x0,y0);write('Й');

for i:=x0+1 to x-1 do

begin

gotoxy(i,y0);

write('Н');

end;

Write('»');

gotoxy(10+gotocen(s),y0);

textcolor(white);

write(s);

for i:=y0+1 to y-1 do

begin

j:=x0;

textcolor(color);

gotoxy(j,i);

write('є');

textcolor(white);

for j:=x0+1 to x-1 do

write(' ');

TextColor(color);

write('є');

end;

gotoxy(x0,y);

write('И');

for i:=x0+1 to x-1 do

write('Н');

write('ј');

textcolor(yellow);

end; {MakeRamka}

procedure field;

var

i:integer;

begin{field}

MakeRamka(22,3,'Delo uchschegosya',78,24,white,cyan);

textcolor(black);

gotoxy(24,5);

write('№ Dela ');

gotoxy(24,7);

write('” Фамилия ');

gotoxy(24,9);

write('Имя ');

gotoxy(24,11);

write('Отчество ');

gotoxy(24,13);

write('Дата рождения ');

gotoxy(24,15);

write('Familiya kuratora ');

gotoxy(24,17);

write('Imya kuratora ');

gotoxy(24,19);

write('Otchestvo kuratora ');

gotoxy(24,23);

write('Клавиша F8 - Удаление дела');

textbackground(black);

textcolor(white);

for i:=1 to 9 do

begin

gotoxy(50,3+i*2);

write(' ');

end;

end;{field}

procedure archieve;

var

i:integer;{Ї а ¬Ґва жЁЄ« }

begin{archieve}

MakeRamka(22,3,'‘®еа ­Ґ­ЁҐ/‡ Јаг§Є ',78,24,white,cyan);

textcolor(black);

textbackground(cyan);

gotoxy(30,13);

write('€¬п д ©« ');

{‚лў®¤ ЇаҐ¤гЇаҐ¦¤Ґ­Ёп}

gotoxy(30,15);

write('‚­Ё¬ ­ЁҐ! “Є § ў Ё¬п бгйҐбвўго饣® д ©« ');

gotoxy(30,16);

write('ЇаЁ б®еа ­Ґ­ЁЁ ¤ ­­ле, ‚л Џ…ђ…‡ЂЏ€�…’…');

gotoxy(30,17);

write('ҐЈ® ᮤҐа¦Ё¬®Ґ!');

textbackground(black);

textcolor(white);

gotoxy(40,13);

write(' ');

end;{archieve}

procedure menuarchh;

var

io, pos, i, ii, ind: integer;

ch: char;

s: string;

begin{menuarchh}

s:='';

menucl;

ind:=1;

pos:=41;

ii:=1;

archieve;

repeat

repeat

for i:=1 to 3 do

begin

if i=ind

then

begin

textbackground(white);

textcolor(black);

end

else

begin

textcolor(white);

textbackground(black);

end;

gotoxy(2,i*2+1);

write(menuarch[i]);

end;

ch:=readkey;

gotoxy(30,19);

textbackground(cyan);

write(' ');

textcolor(white);

case ch of

#8:{backspace}

if (s<>'')

then

begin

dec(ii);

delete(s,ii,1);

textbackground(black);

textcolor(white);

gotoxy(40,13);

write(' ');

gotoxy(40,13);

write(s);

end;

#80:

if ind<>3

then

inc(ind);

#72:

if ind<>1

then

dec(ind);

else

if chr(ord(ch)) in simvv

then

if ii<=8

then

begin

gotoxy(40,13);

s:=s+chr(ord(ch));

textbackground(black);

textcolor(white);

write(s);

inc(ii);

end;

end;

until ch=#13;

assign(fileill,s+'.dat');

case ind of

1: begin

rewrite(fileill);

for i:=1 to illcount do

write(fileill,masill[i]);

close(fileill);

ind:=3;

end;

2: begin

{$i-}

reset(fileill);

io:=ioresult;

{$i+}

If io = 0

then

begin

for i:=1 to illcount do

read(fileill,masill[i]);

close(fileill);

end;

end;

end;

if (ind = 2)

then

if (io = 0)

then

ind:=3

else

begin

textcolor(red);

textbackground(cyan);

gotoxy(30,19);

write('” ©« ­Ґ ­ ©¤Ґ­!');

end;

until ind=3;

clear;

end;{menuarchh}

procedure menunewkar;

var

numerr, tmp, code,ii, posy, i, ind:integer;

ch:char;

tempm:array [1..9] of string[20];

s,ss:string[20];

sd: char;

errd, flagg:boolean;

begin{menunewkar}

menucl;

ind:=1;

field;

posy:=1;

ii:=1;

s:='';

if flag

then

numb:=numfind

else

for i:=illcount downto 1 do

if (masill[i].number = 0)

then

numb:=i;

{+++++++++++++++++++++}

gotoxy(50,posy*2+3);

write(numb);

if flag

then

begin

str(numb,ss);

tempm[1]:=ss;

tempm[2]:=masill[numb].sur;

tempm[3]:=masill[numb].name;

tempm[4]:=masill[numb].otch;

tempm[5]:=masill[numb].dateburn;

tempm[6]:=masill[numb].surdoc;

tempm[7]:=masill[numb].namedoc;

tempm[8]:=masill[numb].otchdoc;

for i:=1 to 8 do

begin

gotoxy(50,i*2+3);

write(' ');

gotoxy(50,i*2+3);

write(tempm[i]);

end;

end

else

begin

tempm[1]:='';

tempm[2]:='';

tempm[3]:='';

tempm[4]:='';

tempm[5]:='';

tempm[6]:='';

tempm[7]:='';

tempm[8]:='';

Страницы: 1, 2, 3, 4, 5, 6, 7, 8