TP / 11 / U1136

unit prog;
uses Crt, Dos;

const
Base = 'Base.dat';
Len = 29;
X1W = 20; Y1W = 5; {X1,Y1,X2,Y2 for Window}
X2W = 80; Y2W = 25;
HC = Yellow; THC = Brown; { HeaderColor, TableHeaderColor }
TC = LightGray;
MTC = Brown; STC = White; { MenuTextColor, SelectTextColor }
LU = #218; RU = #191; { LeftUp, RightUp }
LD = #192; RD = #217; { LeftDown, RightDown }
H = #196; V = #179; { Horisontal, Vertical }

type
AMenu = array[1..7] of String[10];
Worker = record
FIO: string[Len];
Kafedra,Dolgnost,Razrad: Byte;
Stavka: Real;
Oklad,Zarplata: Longint;
end;
PtrPoint = ^Point;
Point = record
D: Worker;
Pred, Next: PtrPoint;
end;

const
M: AMenu = (
'Џа®б¬®ва',
'„®Ў ўЁвм',
'€§¬Ґ­Ёвм',
'“¤ «Ёвм',
'Џ®ЁбЄ',
'‘®авЁа®ўЄ ',
'‚л室');
FM: AMenu = (
'”€Ћ',
'Љ дҐ¤а ',
'„®«¦­®бвм',
'ђ §ап¤',
'‘в ўЄ ',
'ЋЄ« ¤',
'‡ аЇ« в ');

var
R: Registers;
ListBegin, ListEnd: PtrPoint;
i: Byte;
Index: Integer;
f: file of Worker;

procedure HeaderX(X: Byte; s: String);
function MouseInButton(X1M,Y1M,X2M:Byte): Boolean;
procedure Run(i: Byte);
procedure Menu(X1,Y1,X2,Y2,n: Byte; Me: AMenu);
{ Џа®жҐ¤га  ўлў®¤Ёв ­  нЄа ­ ¬Ґ­о Ё§ n н«Ґ¬Ґ­в®ў ¬ ббЁў  M
ў ®Є­Ґ б Є®®а¤Ё­ в ¬Ё (X1;Y1), (X2;Y2), Ё ®бгйҐбвў«пҐв ўлЎ®а
н«Ґ¬Ґ­в  ¬Ґ­о Ё § Їг᪠ᮮ⢥бвўго饩 Їа®г¤гал.
Џ а ¬Ґвал: Є®®а¤Ё­ вл ®Є­ , Є®«ЁзҐбвў® Їг­Єв®ў ¬Ґ­о, ⥪бв Є­®Ї®Є}
procedure MakeList;
function SeekofPoint(n: Integer): PtrPoint;
procedure Max;
procedure Viewing;
procedure Additing;
procedure Editing;
procedure Deleting;
procedure Searching;
function Direct(C: Boolean; D: Char): Boolean;
procedure Sorting;
procedure WriteF;
{------------------------------------------------------------}
IMPLEMENTATION
{------------------------------------------------------------}
procedure HeaderX(X: Byte; s: String);
begin
TextBackground(Black);
ClrScr;
TextColor(HC);
GotoXY(X,1); Write(s);
GotoXY(1,3);
TextColor(TC);
end;

function MouseInButton(X1M,Y1M,X2M:Byte): Boolean;
var
X1,Y1,X2,Y2: Integer;
begin
MouseInButton:= False;
R.AX:= $03; Intr($33,R);
for i:=1 to 7 do begin
X1:= X1M*8;
Y1:= Y1M*8 + (i-1)*8;
X2:= X2M*8;
Y2:= Y1 + 8;
if (R.CX > X1) and (R.CX < X2) and
(R.DX > Y1) and (R.DX < Y2) then begin
MouseInButton:= True;
exit;
end;
end;
end;

procedure Run(i: Byte);
begin
case i of
1: Viewing;
2: Additing;
3: Editing;
4: Deleting;
5: Searching;
6: Sorting;
7: halt;
end;
end;

procedure Menu(X1,Y1,X2,Y2,n: Byte; Me: AMenu);
var
ch: Char;
s: String;
begin
R.AX:= $00; Intr($33,R);
R.AX:= $01; Intr($33,R);
Window(X1,Y1,X2,Y2);
{ ђЁб㥬 а ¬Єг }
s:= '';
for i:=1 to 12 do
s:= s + H;
TextColor(MTC);
Write(LU,s,RU);
GotoXY(1,9); Write(LD,s,RD);
for i:=1 to n do begin
GotoXY(1,1+i); Write(V);
GotoXY(14,1+i); Write(V);
end;
{ ‚лў®¤Ё¬ ¬Ґ­о }
for i:=1 to n do begin
GotoXY(3,1+i); Write(Me[i]);
end;
{ ‡ ЇгбЄ Ґ¬ жЁЄ« ўлЎ®а  Їг­Єв  ¬Ґ­о }
repeat
if MouseInButton(X1,Y1,X2) then
repeat
R.AX:= $03; Intr($33,R);
if R.BX = 1 then
if Me[1] = 'Џа®б¬®ва' then begin
Run(i);
exit;
end else exit;
until not MouseInButton(X1,Y1,X2);
until False;
end;

procedure MakeList;
var
i: Integer;
w: Worker;
p,r: PtrPoint;
begin
reset(f);
if Index>0 then Read(f,w);
New(p); ListBegin:= p;
p^.D:= w;
p^.Pred:= NIL; p^.Next:= NIL;
for i:= 2 to Index do begin
Read(f,w);
New(r);
r^.D:= w;
p^.Next:= r; r^.Pred:= p;
r^.Next:= NIL;
p:= r;
end;
ListEnd:= p;
close(f)
end;

function SeekofPoint(n: Integer): PtrPoint;
var
p: PtrPoint;
i: Integer;
begin
New(p);
p:= ListBegin;
for i:=1 to n-1 do
p:= p^.Next;
SeekofPoint:= p;
end;

procedure Max;
begin
reset(f);
Index:= FileSize(f);
close(f);
end;

procedure Viewing;
var
i: Integer;
p: PtrPoint;
begin
Window(X1W,Y1W,X2W,Y2W);
New(p);
p:= ListBegin;
HeaderX(25,'Џа®б¬®ва');
TextColor(THC);
WriteLn(' ” ¬Ё«Ёп €¬п ЋвзҐбвў® Љ „ ђ ‘ ЋЄ« ¤ ‡ аЇ« в ');
TextColor(TC);
WriteLn;
for i:= Index downto 1 do begin
with p^.D do
WriteLn(FIO:Len,Kafedra:2,Dolgnost:2,
Razrad:3,Stavka:4:1,Oklad:7,Zarplata:9);
p:= p^.Next;
end;
ReadKey;
TextMode(Co80);
end;

procedure Additing;
var
p,r: PtrPoint;
begin
repeat
Window(X1W,Y1W,X2W,Y2W);
HeaderX(25,'„®Ў ў«Ґ­ЁҐ');
New(p);
p:= ListEnd;
New(r);
p^.Next:= r;
r^.Pred:= p;
r^.Next:= NIL;
with r^.D do begin
Inc(Index);
WriteLn(Index);
Write('”€Ћ: '); ReadLn(FIO);
Write('Љ дҐ¤а : '); ReadLn(Kafedra);
Write('„®«¦­®бвм: '); ReadLn(Dolgnost);
Write('ђ §ап¤: '); ReadLn(Razrad);
Write('‘в ўЄ : '); ReadLn(Stavka);
Write('ЋЄ« ¤: '); ReadLn(Oklad);
Zarplata:= Round(Stavka * Oklad);
end;
ListEnd:= r;
WriteLn;
WriteLn('Enter - ¬Ґ­о');
WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
until ReadKey = #13;
TextMode(Co80);
end;

procedure Editing;
var
i: Integer;
p: PtrPoint;
wt: Worker;
begin
repeat
Window(X1W,Y1W,X2W,Y2W);
New(p);
p:= ListBegin;
HeaderX(25,'€§¬Ґ­Ґ­ЁҐ');
Write('‚ўҐ¤ЁвҐ ­®¬Ґа § ЇЁбЁ: '); ReadLn(i);
if not (i in [1..Index]) then begin
TextColor(Brown);
WriteLn('ЌҐЇа ўЁ«м­® ўўҐ¤Ґ­ ­®¬Ґа Є ав®зЄЁ!');
WriteLn('Ћ­ ¤®«¦Ґ­ Ўлвм: 1..',Index);
TextColor(TC);
ReadKey;
exit;
end
else begin
p:= SeekofPoint(i);
wt:= p^.D;
with p^.D do begin
Write('”€Ћ: '); ReadLn(FIO);
if FIO = '0' then FIO:= wt.FIO;
Write('Љ дҐ¤а : '); ReadLn(Kafedra);
if Kafedra = 0 then Kafedra:= wt.Kafedra;
Write('„®«¦­®бвм: '); ReadLn(Dolgnost);
if Dolgnost = 0 then Dolgnost:= wt.Dolgnost;
Write('ђ §ап¤: '); ReadLn(Razrad);
if Razrad = 0 then Razrad:= wt.Razrad;
Write('‘в ўЄ : '); ReadLn(Stavka);
if Stavka = 0 then Stavka:= wt.Stavka;
Write('ЋЄ« ¤: '); ReadLn(Oklad);
if Oklad = 0 then Oklad:= wt.Oklad;
Zarplata:= Round(Stavka * Oklad);
end;
end;
WriteLn;
WriteLn('Enter - ¬Ґ­о');
WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
until ReadKey = #13;
TextMode(Co80);
end;

procedure Deleting;
var
i,n: Integer;
p,r: PtrPoint;
w: Worker;
begin
Window(X1W,Y1W,X2W,Y2W);
repeat
WriteLn;
WriteLn('1 - “¤ «Ёвм ®¤­г § ЇЁбм');
WriteLn('0 - “¤ «Ёвм ўбҐ § ЇЁбЁ');
WriteLn;
case ReadKey of
'1': begin
Write('‡ ЇЁбм N: '); ReadLn(n);
if not (n in [1..Index]) then begin
TextColor(Brown);
WriteLn('ЌҐЇа ўЁ«м­® ўўҐ¤Ґ­ ­®¬Ґа Є ав®зЄЁ!');
WriteLn('Ћ­ ¤®«¦Ґ­ Ўлвм: 1..',Index);
TextColor(TC);
ReadKey;
exit;
end
else begin
dec(Index);
if n = 1 then begin
p:= ListBegin;
ListBegin:= ListBegin^.Next;
if ListBegin = NIL then begin
ListEnd:= NIL;
TextColor(Red);
WriteLn('„ ­­лҐ г¤ «Ґ­л');
WriteLn('‘ЇЁб®Є Їгбв');
TextColor(TC);
ReadKey; exit;
end
else begin
ListBegin^.Pred:= NIL;
dispose(p);
TextColor(Red); WriteLn('„ ­­лҐ г¤ «Ґ­л'); TextColor(TC);
end;
end
else begin
p:= SeekofPoint(n-1);
r:= p^.Next;
p^.Next:= r^.Next;
dispose(r);
r:= p^.Next;
if not (r = NIL) then r^.Pred:= p
else r:= p;
ListEnd:= r;
TextColor(Red); WriteLn('„ ­­лҐ г¤ «Ґ­л'); TextColor(TC);
end;
end;
end;
'0': begin
for i:=1 to Index do begin
p:= ListBegin;
ListBegin:= ListBegin^.Next;
dispose(p);
end;
ListEnd:= NIL;
TextColor(Red); WriteLn('‚ᥠ¤ ­­лҐ г¤ «Ґ­л'); TextColor(TC);
end;
end;
WriteLn;
WriteLn('Enter - ¬Ґ­о');
WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
until ReadKey = #13;
TextMode(Co80);
end;

procedure Searching;
var
i: Integer;
p: PtrPoint;
wf,w: Worker;
begin
Window(X1W,Y1W,X2W,Y2W);
repeat
HeaderX(25,'Џ®ЁбЄ');
Menu(4,4,8,12,7,FM);
New(p);
Case i of
1: begin
Write('”€Ћ: '); ReadLn(wf.FIO);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if Pos(wf.FIO,FIO) > 0 then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
2: begin
Write('Љ дҐ¤а  '); ReadLn(wf.Kafedra);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Kafedra = Kafedra then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
3: begin
Write('„®«¦­®бвм '); ReadLn(wf.Dolgnost);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Dolgnost = Dolgnost then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
4: begin
Write('ђ §ап¤ '); ReadLn(wf.Razrad);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Razrad = Razrad then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
5: begin
Write('‘в ўЄ  '); ReadLn(wf.Stavka);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Stavka = Stavka then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
6: begin
Write('ЋЄ« ¤ '); ReadLn(wf.Oklad);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Oklad = Oklad then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
7: begin
Write('‡ аЇ« в  '); ReadLn(wf.Zarplata);
p:= ListBegin;
while not (p=NIL) do with p^.D do begin
if wf.Zarplata = Zarplata then
WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);
p:= p^.Next;
end;
end;
end;
WriteLn;
WriteLn('Enter - ¬Ґ­о');
WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
until ReadKey = #13;
TextMode(Co80);
end;

function Direct(C: Boolean; D: Char): Boolean;
begin
if D = '+' then Direct:= C else Direct:= not C;
end;

procedure Sorting;
var
Ch,D: Char;
Direction: Boolean;
i,j,Nt: Integer;
p,r,s: PtrPoint;
w1,w2,wt: Worker;
begin
Window(X1W,Y1W,X2W,Y2W);
repeat
HeaderX(25,'‘®авЁа®ўЄ ');
Menu(4,4,8,12,7,FM);
Case i of
1: WriteLn('”€Ћ');
2: WriteLn('Љ дҐ¤а ');
3: WriteLn('„®«¦­®бвм');
4: WriteLn('ђ §ап¤');
5: WriteLn('‘в ўЄ ');
6: WriteLn('ЋЄ« ¤');
7: WriteLn('‡ аЇ« в ');
end;
Write('Ќ Їа ў«Ґ­ЁҐ (+,-): '); ReadLn(D);
New(p); New(r); New(s);
p:= ListBegin;
for i:=0 to Index-2 do begin
p:= SeekofPoint(i+1);
w1:= p^.D;
wt:= w1;
for j:=i to Index-1 do begin
p:= SeekofPoint(i+1);
w2:= p^.D;
Case i of
1: Direction:= Direct(w2.FIO < w1.FIO, D);
2: Direction:= Direct(w2.Kafedra < w1.Kafedra, D);
3: Direction:= Direct(w2.Dolgnost < w1.Dolgnost, D);
4: Direction:= Direct(w2.Razrad < w1.Razrad, D);
5: Direction:= Direct(w2.Stavka < w1.Stavka, D);
6: Direction:= Direct(w2.Oklad < w1.Oklad, D);
7: Direction:= Direct(w2.Zarplata < w1.Zarplata, D);
end;
if Direction then begin
wt:= w2;
Nt:= j;
end;
end;
Case i of
1: Direction:= Direct(wt.FIO < w1.FIO, D);
2: Direction:= Direct(wt.Kafedra < w1.Kafedra, D);
3: Direction:= Direct(wt.Dolgnost < w1.Dolgnost, D);
4: Direction:= Direct(wt.Razrad < w1.Razrad, D);
5: Direction:= Direct(wt.Stavka < w1.Stavka, D);
6: Direction:= Direct(wt.Oklad < w1.Oklad, D);
7: Direction:= Direct(wt.Zarplata < w1.Zarplata, D);
end;
if Direction then begin
p:= SeekofPoint(i+1); p^.D:= wt;
r:= SeekofPoint(Nt); r^.D:= w1;
s:= r^.Pred; r^.Pred:= p^.Pred; p^.Pred:= s;
s:= r^.Next; r^.Next:= p^.Next; p^.Next:= s;
end;
end;
Viewing;
WriteLn;
WriteLn('Enter - ¬Ґ­о');
WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
until ReadKey = #13;
TextMode(Co80);
end;

procedure WriteF;
var
i: Integer;
p,r: PtrPoint;
begin
rewrite(f);
new(p);
p:= ListBegin;
for i:=1 to Index do begin
Write(f,p^.D);
p:= p^.Next;
end;
close(f);
p:= ListBegin;
for i:=1 to Index-1 do begin
r:= p;
p:= p^.Next;
dispose(r);
end;
dispose(p);
end;

{------------------------------------------------------------}

begin
assign(f,Base);
{$I-}
reset(f);
{$I+}
if IOResult<>0 then rewrite(f);
close(f);
end.