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.