Текст программы на алгоритмическом языке

program otdel_kadrov;

uses crt,graph;

const

main = 'MAIN MENU';

d: array[1..5] of string[21] =

('Assistent','St.Prepodavatel','Docent',

'Professor','Deloproizvoditel');

type

fio = record

fam:string[20];

name: string[10];

lastname: string[15];

end;

rec = record

man:fio;

dolzhnost:string[21];

facultet:string[20];

kafedra:string[20];

age: byte;

work:byte;

end;

var

f: file of rec;

person:rec;

num,i:integer;

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 vvod;

var j:integer;

begin

with person do

begin

textcolor(yellow); write('Input surname ');

textcolor(white); readln(man.fam); writeln;

textcolor(yellow); write('Input name ');

textcolor(white); readln(man.name); writeln;

textcolor(yellow); write('Input lastname ');

textcolor(white); readln(man.lastname); writeln;

textcolor(yellow); writeln('Choose your doljnost:');

for j:=1 to 5 do writeln(j, ' - ',d[j]);

textcolor(white); readln(j); person.dolzhnost:=d[j];

writeln('You have chosen ',d[j]);

textcolor(yellow); write('Input facultet ');

textcolor(white); readln(facultet); writeln;

textcolor(yellow); write('Input kafedra ');

textcolor(white); readln(kafedra); writeln;

textcolor(yellow); write('Input age ');

textcolor(white); readln(age); writeln;

textcolor(yellow); write('Input length work ');

textcolor(white); readln(work); writeln;

textcolor(red);

writeln('Dobavleno');

end;

end;

procedure hat(k:integer;s:string);

begin

gotoXY(25,2); textcolor(red);

writeln(s); textcolor(yellow);

gotoXY(1,k); writeln('N');

gotoXY(4,k); write('Surname');

gotoXY(15,k); write('Name');

gotoXY(22,k);write('Last Name');

gotoXY(36,k);write('Dolzhnost');

gotoXY(53,k);write('Facultet');

gotoXY(62,k);write('Kafedra');

gotoXY(73,k);write('Age');

gotoXY(77,k);write('LWo');

end;

procedure rezult(h,k:integer;z:rec);

begin

gotoXY(1,h); writeln(k);

gotoXY(4,h); write(z.man.fam);

gotoXY(15,h); write(z.man.name);

gotoXY(22,h);write(z.man.lastname);

gotoXY(36,h);write(z.dolzhnost);

gotoXY(53,h);write(z.facultet);

gotoXY(62,h);write(z.kafedra);

gotoXY(73,h);write(z.age);

gotoXY(77,h);write(z.work);

end;

procedure create;

var i,j,ans:byte;

begin

rewrite(f); i:=0;

textcolor(white);

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 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 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 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;

const p='Professor';

var b:boolean;

ans: byte;

i:integer;

begin

clrscr; b:=false;

hat(4,'All Professors');

textcolor(white);

reset(f); i:=0;

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;

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;

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;

procedure menu;

const

n=8;

var

menu:array[1..n] of string[25];

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

menu[1]:=' New Base ';

menu[2]:=' Add Record ';

menu[3]:=' Display ';

menu[4]:=' Search Kafedra';

menu[5]:=' All Professors';

menu[6]:=' Oldest Prepodavatel';

menu[7]:=' Sort by Length Of Work';

menu[8]:='Exit';

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;

begin

filemode:=2;

zastavka;

assign(f,'vuz.dat');

menu;

end.