Файловый архив студентов. Файловый архив студентов.
1327 вузов, 5495 предметов.
/ Регистрация
FAQ Обратная связь Вопросы и предложения
Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Пермский национальный исследовательский политехнический университет
Предмет:
Информатика
Файл:

TP / 10 / UNIT36

.PAS
Скачиваний:
32
Добавлен:
10.12.2013
Размер:
10 Кб
Скачать
☆ 
UNIT Unit36;
{------------------------------------------------------------}
                          INTERFACE
{------------------------------------------------------------}
uses Crt;

const
  Base = 'Base.dat';
  Temp = 'Temp.dat';
  LengthFIO = 30;
  HC = Yellow;
  THC = Brown;

type
  Worker = record
    N: Integer;
    FIO: string[LengthFIO];
    Kafedra,Dolgnost,Razrad: Byte;
    Stavka,Oklad,Zarplata: Real;
  end;

var
  Index: Integer;
  w: Worker;
  f,ft: file of Worker;

procedure Header(s: String);
procedure Menu;
procedure FMenu;
procedure MaxIndex;
procedure Viewing;
procedure Additing;
procedure Editing;
procedure Deleting;
procedure Searching;
function Direct(C: Boolean; D: Char): Boolean;
procedure Sorting;
{------------------------------------------------------------}
                          IMPLEMENTATION
{------------------------------------------------------------}
procedure Header;
begin
  ClrScr;
  TextColor(HC);
  GotoXY(35,1); Write(s);
  GotoXY(1,3);
  TextColor(LightGray);
end;

procedure Menu;
begin
  Header('‹ Ў®а в®а­ п 10');
  WriteLn('1 - Џа®б¬®ва');
  WriteLn('2 - „®Ў ўЁвм');
  WriteLn('3 - €§¬Ґ­Ёвм');
  WriteLn('4 - “¤ «Ёвм');
  WriteLn('5 - Џ®ЁбЄ');
  WriteLn('6 - ‘®авЁа®ўЄ ');
  WriteLn('Esc - ‚л室');
end;

procedure FMenu;
begin
  WriteLn('1 - ”€Ћ');
  WriteLn('2 - Љ дҐ¤а ');
  WriteLn('3 - „®«¦­®бвм');
  WriteLn('4 - ђ §ап¤');
  WriteLn('5 - ‘в ўЄ ');
  WriteLn('6 - ЋЄ« ¤');
  WriteLn('7 - ‡ аЇ« в ');
  WriteLn;
end;

procedure MaxIndex;
var
  w: Worker;
begin
  reset(f);
  Index:= 0;
  while not EOF(f) do begin
    Inc(Index);
    Read(f,w);
  end;
  close(f);
end;

procedure Viewing;
var
  i: Integer;
begin
  MaxIndex;
  reset(f);
  Header('Џа®б¬®ва');
  TextColor(THC);
  WriteLn('N       ” ¬Ё«Ёп €¬п ЋвзҐбвў®    Љ д „®«¦ ђ §а ‘в ўЄ   ЋЄ« ¤     ‡ аЇ« в ');
  TextColor(LightGray);
  WriteLn;
  for i:= 1 to Index do begin
    Read(f,w);
    with w do
      WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
        Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
  end;
  ReadKey;
  close(f);
end;

procedure Additing;
begin
  repeat
    MaxIndex;
    reset(f);
    Seek(f,Index);
    Header('„®Ў ў«Ґ­ЁҐ');
    with w do begin
      WriteLn(Index+1); N:= Index+1;
      Write('”€Ћ: '); ReadLn(FIO);
      Write('Љ дҐ¤а : '); ReadLn(Kafedra);
      Write('„®«¦­®бвм: '); ReadLn(Dolgnost);
      Write('ђ §ап¤: '); ReadLn(Razrad);
      Write('‘в ўЄ : '); ReadLn(Stavka);
      Write('ЋЄ« ¤: '); ReadLn(Oklad);
      Zarplata:= Stavka * Oklad;
    end;
    Write(f,w);
    WriteLn;
    WriteLn('Enter - ¬Ґ­о');
    WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
    close(f);
  until ReadKey = #13;
end;

procedure Editing;
var
  i: Integer;
  wt: Worker;
begin
  repeat
    MaxIndex;
    reset(f);
    Header('€§¬Ґ­Ґ­ЁҐ');
    Write('‚ўҐ¤ЁвҐ ­®¬Ґа § ЇЁбЁ: '); ReadLn(i);
    if not (i in [1..Index]) then begin
      TextColor(Brown);
      WriteLn('ЌҐЇа ўЁ«м­® ўўҐ¤Ґ­ ­®¬Ґа Є ав®зЄЁ!');
      WriteLn('Ћ­ ¤®«¦Ґ­ Ўлвм: 1..',Index);
      TextColor(LightGray);
      ReadKey;
      exit;
    end
    else with w do begin
      Seek(f,i-1); Read(f,wt);
      N:= i;
      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:= Stavka * Oklad;
    end;
    Seek(f,i-1); Write(f,w);
    close(f);
    WriteLn;
    WriteLn('Enter - ¬Ґ­о');
    WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
  until ReadKey = #13;
end;

procedure Deleting;
var
  i,n: Integer;
  w: Worker;
begin
  repeat
    WriteLn;
    WriteLn('1 - “¤ «Ёвм ®¤­г § ЇЁбм');
    WriteLn('0 - “¤ «Ёвм ўбҐ § ЇЁбЁ');
    WriteLn;
    case ReadKey of
    '1': begin
      MaxIndex;
      Write('‡ ЇЁбм N: '); ReadLn(n);
      if not (n in [1..Index]) then begin
        TextColor(Brown);
        WriteLn('ЌҐЇа ўЁ«м­® ўўҐ¤Ґ­ ­®¬Ґа Є ав®зЄЁ!');
        WriteLn('Ћ­ ¤®«¦Ґ­ Ўлвм: 1..',Index);
        TextColor(LightGray);
        ReadKey;
        exit;
      end
      else begin
        reset(f); rewrite(ft);
        for i:= 1 to Index do
          if i<n then begin
            Read(f,w);
            Write(ft,w);
          end
          else if i>n then begin
            Read(f,w);
            w.N:= i-1;
            Write(ft,w);
          end
          else Read(f,w);
        close(f); close(ft);
        erase(f);
        rename(ft,Base);
        TextColor(Red);
        WriteLn('„ ­­лҐ г¤ «Ґ­л');
        TextColor(LightGray);
      end;
    end;
    '0': begin
      erase(f);
      rewrite(f);
      TextColor(Red);
      WriteLn('‚ᥠ¤ ­­лҐ г¤ «Ґ­л');
      TextColor(LightGray);
    end;
    end;
    WriteLn;
    WriteLn('Enter - ¬Ґ­о');
    WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
  until ReadKey = #13;
end;

procedure Searching;
var
  i: Integer;
  wf: Worker;
begin
  repeat
    Header('Џ®ЁбЄ');
    FMenu;
    Case ReadKey of
    '1': begin
      Write('”€Ћ: '); ReadLn(wf.FIO);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if Pos(wf.FIO,w.FIO) > 0 then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '2': begin
      Write('Љ дҐ¤а  '); ReadLn(wf.Kafedra);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Kafedra = w.Kafedra then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '3': begin
      Write('„®«¦­®бвм '); ReadLn(wf.Dolgnost);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Dolgnost = w.Dolgnost then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '4': begin
      Write('ђ §ап¤ '); ReadLn(wf.Razrad);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Razrad = w.Razrad then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '5': begin
      Write('‘в ўЄ  '); ReadLn(wf.Stavka);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Stavka = w.Stavka then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '6': begin
      Write('ЋЄ« ¤ '); ReadLn(wf.Oklad);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Oklad = w.Oklad then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    '7': begin
      Write('‡ аЇ« в  '); ReadLn(wf.Zarplata);
      reset(f);
      while not EOF(f) do begin
        Read(f,w);
        if wf.Zarplata = w.Zarplata then With w Do
          WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
            Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
        end;
      close(f);
    end;
    end;
    WriteLn;
    WriteLn('Enter - ¬Ґ­о');
    WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
  until ReadKey = #13;
end;

function Direct;
begin
  if D = '+' then Direct:= C else Direct:= not C;
end;

procedure Sorting;
var
  Ch,D: Char;
  Direction: Boolean;
  i,j,Nt: Integer;
  w1,w2,wt: Worker;
begin
  repeat
    Header('‘®авЁа®ўЄ ');
    FMenu;
    Ch:= ReadKey;
    Case Ch of
      '1': WriteLn('”€Ћ');
      '2': WriteLn('Љ дҐ¤а ');
      '3': WriteLn('„®«¦­®бвм');
      '4': WriteLn('ђ §ап¤');
      '5': WriteLn('‘в ўЄ ');
      '6': WriteLn('ЋЄ« ¤');
      '7': WriteLn('‡ аЇ« в ');
    end;
    Write('Ќ Їа ў«Ґ­ЁҐ (+,-): '); ReadLn(D);
    MaxIndex;
    reset(f);
    for i:=0 to Index-2 do begin
      Seek(f,i); Read(f,w1);
      wt:= w1; Nt:= w1.N;
      for j:=i to Index-1 do begin
        Seek(f,j); Read(f,w2);
        Case Ch 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 Ch 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
        j:= wt.N;
        wt.N:= w1.N;
        w1.N:= j;
        Seek(f,i); Write(f,wt);
        Seek(f,Nt); Write(f,w1);
      end;
    end;
    close(f);
    Viewing;
    WriteLn;
    WriteLn('Enter - ¬Ґ­о');
    WriteLn('‹оЎ п ¤агЈ п - Їа®¤®«¦Ёвм');
  until ReadKey = #13;
end;

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

begin
  assign(f,Base); assign(ft,Temp);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then rewrite(f);
  close(f);
end.
Соседние файлы в папке 10
Помощь Обратная связь Вопросы и предложения Пользовательское соглашение Политика конфиденциальности