Программирование на языках высокого уровня "Стипендия"

    end;

    w:=n;k:=n;

  end;

 

procedure DrawPMenu;

var

   i:integer;

begin

   clrscr;

   scr;

   fon;

   for i:=1 to n-1 do

     Write(PM[i]);

   Activ;

   write(PM[n]);

  scr;

   fon;

   for i:=n+1 to 7 do

     write(PM[i]);

   scr;

   fon;

   gotoXY(2,25);

   write('     Для перемещениями  между пунктами меню используйте  клавиши ',#27,#26,'             ');

 end;

 

Procedure VbrPM1(var k:integer);

  begin

{   clrscr;}

   PODMen;

   n:=1;

   c:=#2;

   z:=0;

   scr;

   text;

   DrawPMenu(1);

   shap1('studentinf.txt');

   while c<>#13 do

    begin

     repeat

       c:=readkey;

     until (c=#13) or (c=#75) or (c=#77);

     scr;

     fon;

     if (n=1) and (c=#75)

                then n:=2;

     if (n=7) and (c=#77)

                then n:=6;

     if c=#77 then

               begin

                scr;

                n:=n+1;

                if n=8 then n:=1;

                DrawPMenu(n);

                shap1('studentinf.txt');

               end;

     if c=#75 then

              begin

                scr;

                dec(n);

                if n=0 then n:=7;

                DrawPMenu(n);

                shap1('studentinf.txt');

               end;

    end;

    z:=n; k:=n;

  end;

 

  Procedure VbrPM2(var k:integer);

  begin

   clrscr;

   PODMen;

   n:=1;

   c:=#2;

   z:=0;

   scr;

   text;

   DrawPMenu(1);

   shap2('stip.txt');

   while c<>#13 do

    begin

     repeat

       c:=readkey;

     until (c=#13) or (c=#75) or (c=#77);

     scr;

     fon;

     if (n=1) and (c=#75)

                then n:=2;

     if (n=7) and (c=#77)

                then n:=6;

     if c=#77 then

               begin

                scr;

                n:=n+1;

                if n=8 then n:=1;

                DrawPMenu(n);

                shap2('stip.txt');

               end;

     if c=#75 then

              begin

                scr;

                dec(n);

                if n=0 then n:=7;

                DrawPMenu(n);

                shap2('stip.txt');

               end;

    end;

    z:=n; k:=n;

  end;

  end.

 

 

 

 

{****************************************************************************}

{*  Модуль SHAP содержит процедуры для рисования и заполнении данными таблиц     *}

{* Не имеет входных и выходных параметров                                                                        *}

{* Содержиот две основные процедуры shap1, shap2                                                             *}

{****************************************************************************}

Unit Hat;

Interface

    Procedure shap1(fileName:string);{Процедура  прорисовки заголовка таблицы  Сотрудники}

    Procedure shap2(FileName:string);{Процедура  прорисовки заголовка таблицы   Жильцы}

 

 Implementation

  uses crt,cozdan;

  Type

    stud=record

     fam:string[21];

     grup:string[13];

     inf:string[22];

     spec:string[7];

    end;

     st=record

     fam:string[80];

     spec:string[30];

     stip:string[50];

     lgot:string[30];

     end;

 

  {Процедура прорисовки заголовка таблицы Сотрудники}

  Procedure shap1(FileName:string);

   var ft: file of stud;

        lineFile:stud;

rc:integer;

   Begin

    rc:=0;

    textcolor(0);

    assign(ft,FileName) ;

    reset(ft);

    gotoxy(1,7);

    Writeln ('╔════════════════════╦═══════════╦═════════════════════╦══════════════════════╗');

    Writeln ('║        Ф.И.О.      ║   Группа  ║Контактная информация║Название специальности║');

    Writeln ('╠════════════════════╬═══════════╬═════════════════════╬══════════════════════╣');

 

    while (not Eof(ft)) do

      begin

        rc:=rc+1;

        read(ft,linefile);

        with linefile do

 

              begin

                write('║',fam,'║':21-length(fam),grup,'║':12-length(grup),inf,'║':22-length(inf));

                writeln(spec,'║':23-length(spec));

  end;

      end;

 

    writeln('╚════════════════════╩═══════════╩═════════════════════╩══════════════════════╝');

    close(ft);

 

   End;

   {Процедура прорисовки заголовка  таблицы  Жильцы}

   Procedure shap2(FileName:string);

      var ft: file of st;

        lineFile:st;

    Begin

     textbackground(7);

     textcolor(0);

     assign(ft,Filename);

     reset(ft);

     gotoxy(1,7);

     Writeln ('╔═══════════════════════════╦═══════════════════╦═════════════════╦═══════════╗');

     Writeln ('║           Ф.И.О           ║   Специальность   ║     Стипендия   ║   Льготы  ║');

     Writeln ('╠═══════════════════════════╬═══════════════════╬═════════════════╬═══════════╣');

     while (not eof(ft)) do

       begin

         read(ft,linefile);

         with linefile do

           begin

 

                 write('║',fam,'║':28-length(fam),spec,'║':20-length(spec));

                 writeln(stip,'║':18-length(stip),lgot,'║':12-length(lgot));

                end;

 

         end;

    writeln('╚═══════════════════════════╩═══════════════════╩═════════════════╩═══════════╝');

    close(ft);

    textbackground(11);

  End;

End.

 

{****************************************************************************}

{*    Модуль HELP содержит процедуры для выдачи подсказок пользователю                   *}

{* Не имеет входных и выходных параметров                                                                        *}

{*SMS-выводит сообщение о том,что у пользователя нет прав на данное действие*}

{* Pechat –сообщение о неподключенном принтере                                                               *}

{* Dobav –сообщение об успешном добавлении строки                          *}

{* net –сообщение о невозможности выполнения действия                                                 *}

{****************************************************************************}

 

Unit Help;

Interface

   Procedure SMS;

   Procedure Pechat;

   Procedure Dobav;

   Procedure net;

Implementation

  uses crt,printer;

  Procedure SMS;

   begin

    clrscr;

    textcolor(0);

    writeln('╔══════════════════════════════════════════════════╗':65);

    writeln('║            Это действие не доступно!             ║':65);

    writeln('╠══════════════════════════════════════════════════╣':65);

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

    writeln('╚══════════════════════════════════════════════════╝':65);

    readkey;

   end;

  Procedure Pechat;

   var i:integer;

   begin

         clrscr;

         textcolor(0);

         for i:=1 to 6 do

             writeln('');

         writeln('╔══════════════════════════════════════════════════╗':65);

         writeln('║               Принтер не подключен!              ║':65);

         writeln('╠══════════════════════════════════════════════════╣':65);

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

         writeln('╚══════════════════════════════════════════════════╝':65);

         readkey;

   end;

  Procedure Dobav;

   var i:integer;

   begin

     for i:=1 to 6 do

         writeln('');

     writeln('╔══════════════════════════════════════════════════╗':65);

     writeln('║           Строка успешно добавлена!              ║':65);

     writeln('╠══════════════════════════════════════════════════╣':65);

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

     writeln('╚══════════════════════════════════════════════════╝':65);

     readkey;

   end;

  Procedure net;

   var i:integer;

   begin

     clrscr;

     for i:=1 to 6 do

         writeln('');

     writeln('╔══════════════════════════════════════════════════╗':65);

     writeln('║      Данное действие не может быть выполнено !   ║':65);

     writeln('╠══════════════════════════════════════════════════╣':65);

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

     writeln('╚══════════════════════════════════════════════════╝':65);

     readkey;

   end;

end.

 

{****************************************************************************}

{*    Модуль PAROL содержит процедуры для работы с паролем                                       *}

{* Не имеет входных параметров                                                                                            *}

{* ReadPwd-заменяет вводимые символы звездочками                           *}

{* InputParol-осуществляет распознавание пароля и определение ранга вощедшего       *}

{* pol-выходной параметр ранга доступа, от него зависят совершаемые действия*}

{*    Процедура CursorOff – отключает курсор                                                                        *}

{*    Процедура Scr – заливает фон голубым цветом                                                               *}

{*    Процедура Fon- заливает область под надписью серым цветом                                    *}

{*    Процедура  Text – делает цвет надписей черными                                                          *}

{***************************************************************************}

 

 

Unit Parol;

interface

  procedure ReadPwd(var s: string; maxsize: integer);

  Procedure InputParol( var pol:integer);

  Procedure CursorOff;

  Procedure scr;

  Procedure fon;

  Procedure text;

 

Implementation

   uses crt;

   procedure ReadPwd;

    var

      i:integer;

      c1,c2: char;

      tmp: string;

      cx,cy: integer;

      spaces: string;

    begin

     spaces:='';

     for i:=1 to maxsize do spaces:=spaces+' ';

        tmp:='';

     cx:=wherex;

     cy:=wherey;

     repeat

       c1:=readkey;

       if c1=#13 then break;

       if c1=#0 then begin

                      c2:=readkey;

                      continue

                     end;

       if c1=#8 then begin

                       if tmp<>'' then tmp:=copy(tmp,1,length(tmp)-1);

                     end else begin

                          if length(tmp)<maxsize then

                                      tmp:=tmp+c1;

                              end;

 

        textbackground(11);

        textcolor(0);

        gotoxy(cx,cy);

        write(spaces);

        gotoxy(cx,cy);

        for i:=1 to length(tmp) do write('*');

       until false;

       s:=tmp

     end;

 

 

   Procedure CursorOff;Assembler;

     Asm

      mov ah,1

      mov ch,$20

      int $10

     end;

 

   Procedure scr;

      begin

        textbackground(11);

      end;

   Procedure fon;

      begin

        textbackground(7);

      end;

   Procedure text;

      begin

       textcolor(0);

      end;

 

Procedure InputParol( var pol:integer);

   var

        flag:boolean;

        p,r:integer;

        i:1..3;

        psw:string;

kr:char;

 

  begin

   clrscr;

   i:=1;

   scr;

   CursorOff;

 

   repeat

 

      flag:=false;

      text;

      gotoXY(25,6);

      writeln('╔═══════════════════════════════════════╗');

      gotoXY(25,7);

      writeln('║       ВЫБЕРИТЕ УРОВЕНЬ ДОСТУПА:       ║');

      gotoXY(25,8);

      writeln('╠═══════════════════════════════════════╣');

      gotoXY(25,9);

      writeln('║          1-Администратор              ║');

      gotoXY(25,10);

      writeln('║          2-Бухгалтер                  ║');

      gotoXY(25,11);

      writeln('║          3-Гость                      ║');

      gotoXY(25,12);

      writeln('╠═══════════════════════════════════════╣');

      gotoXY(25,13);

      writeln('║         Для выхода нажмите 5          ║');

      gotoXY(25,14);

      writeln('╚═══════════════════════════════════════╝');

      gotoXY(25,16);

      writeln('╔═══════════════════════════════════════╗');

      gotoXY(25,17);

      writeln('║                                       ║');

      gotoXY(25,18);

      writeln('╚═══════════════════════════════════════╝');

      gotoXY(45,17);

      { kr:=readkey;

      if kr=#27 then exit;}

 

      readln(p);

 

      clrscr;

      case p of

        1:begin

             clrscr;

             scr;

             text;

             gotoXY(25,10);

             writeln ('╔═══════════════════════════════════════╗');

             gotoXY(25,11);

             writeln ('║            ВВЕДИТЕ ПАРОЛЬ             ║');

             gotoXY(25,12);

             writeln ('╠═══════════════════════════════════════╣');

             gotoXY(25,13);

             writeln ('║                                       ║');

             GotoXY(25,14);

             writeln('╚═══════════════════════════════════════╝');

             GotoXY(40,13);

             ReadPwd(psw,8);

             if psw='324657' then

                    begin

                       clrscr;

                       scr;

                       text;

                       pol:=1;

                       flag:=true;

                       GotoXY(25,12);