for i:=p to n do begin

gotoxy(x,y+i-1);

write ( menu[i] );

end;

{textattr - предопределенная переменная, отвечающая за цвет фона и символов}

textattr:=sel;

gotoxy(x,y+punkt-1);

write( menu[punkt] ); {выделим строку меню}

textattr:=norm;

end;

procedure forsort; {указ меняются местами}

var

rnom1:integer;

fam1:string[20];

name1:string[20];

otch1:string[20];

date1:string[20];

pol1:string[20];

stag1:integer;

adress1:string[30];

tel1:integer;

dolg1:string[20];

oklad1:integer;

begin

With Next^ do begin

rnom1:=rnom;

fam1:=fam;

name1:=name;

otch1:=otch;

pol1:=pol;

stag1:=stag;

adress1:=Adress;

tel1:=tel;

dolg1:=dolg;

oklad1:=oklad;

end;

With Next^ do begin

rnom:=Cur^.rnom;

fam:=Cur^.fam;

name:=Cur^.name;

otch:=Cur^.otch;

pol:=Cur^.pol;

stag:=Cur^.stag;

adress:=Cur^.Adress;

tel:=Cur^.tel;

dolg:=Cur^.dolg;

oklad:=Cur^.oklad;

end;

With Cur^ do begin

rnom:=rnom1;

fam:=fam1;

name:=name1;

otch:=otch1;

pol:=pol1;

stag:=stag1;

adress:=Adress1;

tel:=tel1;

dolg:=dolg1;

oklad:=oklad1;

end;

end;

procedure Sortirovka; {Сортировка по алфавиту}

begin

Cur:=Top;

While Cur<>nil do

begin

Next:=Cur^.link;

while next<>nil do

begin

if ord(Next^.fam[1]) < ord(Cur^.fam[1]) then

ForSort;

Next:=Next^.link;

end;

cur:=cur^.link;

end;

end;

procedure Uporyad; {Сортровка по окладу}

begin

Cur:=Top;

While Cur<>nil do

begin

Next:=Cur^.link;

while next<>nil do

begin

if ord(Next^.Oklad) > ord(Cur^.Oklad) then

ForSort;

Next:=Next^.link;

end;

cur:=cur^.link;

end;

end;

procedure Position(pos:integer);

var i:integer;

begin

Cur:=Top;

For i:=1 to pos do

if i<>pos then Cur:=Cur^.link;

end;

procedure punkt0; {Очистка базы}

var cc,k,ch:char; i:integer;

key:char;

begin

assign(sotrud,'sotrudn.dat');

cc:=chr(13);

{cc:=readkey;}

if cc=chr(13) then

begin

gotoxy(25,10);

writeln('Вы уверены,что хотите удалить базу????');

gotoxy(25,11);

Writeln('Enter-ДА, Esc-НЕТ');

key:=readkey;

if key=chr(13) then

begin

gotoxy(11,4);

write('0%');

gotoxy(63,4);

write('100%');

gotoxy(13,4);

for i:=1 to 20 do

begin

write('=');

delay(500);

end;

for i:=21 to 34 do

begin

write('=');

delay(1300);

end;

for i:=35 to 50 do

begin

write('=');

delay(200);

end;

rewrite(sotrud);

gotoxy(32,18);

write('База очищена');

gotoxy(32,19);

write('Нажмите клавишу Esc');

end;

end;

end;

procedure punkt1; {Новый сотрудник}

var k,ch:char;

begin

clrscr;

gotoxy(12,wherey);writeln('*************************************');

gotoxy(12,wherey);writeln('Добавьте в базу информацию о новом сотруднике - "Enter"');

gotoxy(12,wherey);writeln('*************************************');

ch:=readkey;

if ch<>chr(27) then

begin

new(Cur);

writeln(' Введите информацию');

write('Регистрационный номер: ');

readln(Cur^.rnom);

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

readln(Cur^.fam);

write('Имя: ');

readln(Cur^.name);

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

readln(Cur^.otch);

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

readln(Cur^.date);

write('Пол: ');

readln(Cur^.pol);

write('Стаж работы: ');

readln(Cur^.stag);

write('Домашний адрес: ');

readln(Cur^.adress);

write('Телефон: ');

readln(Cur^.tel);

write('Должность: ');

readln(Cur^.dolg);

write('Оклад: ');

readln(Cur^.oklad);

Cur^.link:=Top;

Top:=Cur;

end;

end;

procedure Punkt2; {Уволить}

var

rnom1:integer;

fam1,name1, otch1:string[20];

pos,f:integer;

key:char;

begin

clrscr;

writeln(' *******************************************');

writeln(' Будите удалять сотрудика из базы - "Enter"');

writeln(' *******************************************');

ch:=readkey;

if ch=chr(13) then

begin

clrscr;

if top=nil then begin

writeln('База пуста');

readln;

end

else

BEGIN

writeln(' **********************');

writeln(' Увольнение сотрудника');

writeln(' **********************');

writeln('Пожалуйста введите');

Writeln('Регистрационный номер увольняемого ');readln(rnom1);

writeln('Фамилия увольняемого: ');readln(fam1);

writeln('Имя увольняемого: ');readln(name1);

writeln('Отчество увольняемого: ');readln(otch1);

Cur:=Top;

pos:=1;

repeat

f:=0;

If Cur^.rnom=rnom1 then

If Cur^.fam=fam1 then

If Cur^.Name=name1 then

if Cur^.otch=otch1 then

begin

writeln('Вы действительно хотите удалить данного сотрудника');

Writeln('Enter-ДА, Esc-НЕТ');

key:=readkey;

if key=chr(13) then

begin

if Cur^.link=nil then begin dispose(Cur); f:=1; end

else

If Cur=Top then begin

If Top^.link<>nil then

begin

Top:=Top^.link;

dispose(Cur);

f:=1;

end;

end

else

begin

Position(pos-1);

Prev:=Cur;

Cur:=Cur^.link;

Next:=Cur^.link;

Prev^.link:=Next;

Dispose(Cur);

f:=1;

end;

writeln('Сотрудник ' ,fam1,' ',name1,' ',otch1, ' уволен ');

readkey;

end;

end;

Cur:=Cur^.link;

pos:=pos+1;

if (cur=nil) and (f=0) then

begin

WriteLn('Искомый сотрудник не числется.');

writeln('Возможно имя или фамилия были введены с маленькой буквы');

Write('Для продолжения нажмите любую клавишу.');

readkey;

break;

end;

until f=1;

end;

END;

end;

procedure Punkt3; {Просмотр}

var ch:char;

begin

clrscr;

sortirovka;

writeln(' **********************');

writeln(' Список сотрудников');

writeln(' **********************');

Cur:=Top;

if top=nil then write('nichego netu')

else

Repeat

write('Регистрационный номер: ');writeln(Cur^.rnom);

write('Фамилия: ');write(Cur^.fam);

gotoxy(40,wherey); write('Год и Дата рождения: ');writeln(Cur^.date);

write('Имя: ');write(Cur^.name);

gotoxy(40,wherey);write('Домашний адрес: ');writeln(Cur^.adress);

write('Отчество: ');write(Cur^.otch);

gotoxy(40, wherey);write('Телефон: ');writeln(Cur^.tel);

write('Пол: ');write(Cur^.pol);

gotoxy(40,wherey);write('Должность: ');writeln(Cur^.dolg);

Страницы: 1, 2, 3