praktika-pascal-2PO07/PRAKTIKA.PAS

program pr;
 uses crt, graph, dos;
 var tmp_d, tmp_m     :     integer; {screen variables}
     p,p1             :     char;    {readkey}
     y_wlcm           :     integer; {Vsplivayushii text}
     i,e,nlect        :     integer; {Vspomogatelnie peremennye}
     cur              :     integer; {Posicia kursora v menu}
     x,y, hgt          :     integer; {Peremennye dlya vyvoda teksta}
     ch, cf, ct       :     integer; {Peremennye dlya chtenia teksta}
     nolect           :     integer; {Nomer lekcii}
     numtest, otv     :     integer; {Test}
     f                :     text;    {File lekcii}
     th,tm,ts,tms     :     word;    {<7B>६<EFBFBD>}
     t1,t2, tminim    :     longint; {<7B>६<EFBFBD>}
     javame, author,
     welcome, dtpa, s,
     menustatus, tmp,
     teststatus,
     lectstatus,path,j:     string;
     mainmenu         :     array [1..22] of string; {menu}
     lines            :     array [1..30] of string; {readtext}
     test             :     array [1..5] of string; {readtest}

     {Procedura inicializacii grafiki}
     procedure init_screen;
     begin
      tmp_d := detect;
      initgraph(tmp_d, tmp_m, '');
      if (graphresult<>0) then
      begin
        writeln('Graphical interface not used. Exit...');
        readkey;
        halt;
      end;
     end;

     procedure menu ; forward;
     procedure lections(var lect:integer); forward;
     procedure ui(ttitle, tbar : string; back : integer); forward;
     procedure question(var tst:integer); forward;
     procedure marks(var pr_otv: integer); forward;

     {Procedura inicializacii peremennyh}
     procedure init_variables;
     begin
      cf                 := 9;
      ct                 := 14;
      x                  := 20;
      hgt               := 400; {Vysota svobodnoy oblasti pri vyvode teksta}
      y_wlcm             := -20;
      cur                := 1;
      author             := '<27><><EFBFBD><EFBFBD><EFBFBD>: <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> aNNiMON <20><><EFBFBD>쭨<EFBFBD>';
      dtpa               := '<27><><EFBFBD><EFBFBD> 2<><32>-07';
      welcome            := '<27>ਢ<EFBFBD><E0A8A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
      javame             := 'JavaME';
      lectstatus         := 'F1 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>          T - <20><><EFBFBD><EFBFBD>          ESC - <20><><EFBFBD><EFBFBD>';
      teststatus         := 'F1 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>          L - <20><><EFBFBD>樨          ESC - <20><><EFBFBD><EFBFBD>';
      menustatus         := 'ESC - <20><>室   UP,DOWN,LEFT,RIGHT - <20><>।<EFBFBD><E0A5A4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>   ENTER - <20><><EFBFBD><EFBFBD>室';
      path               := {'Y:\SCHOOL.PAK\2PO-07\'}'C:\BP\BIN\annimon\' {'D:\TP\BIN\annimon\'};
      {Menu Lekcii}
      for i:= 1 to 10 do
      begin
       str(i, tmp);
       mainmenu[i*2-1] := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> #'+tmp;
       mainmenu[i*2] := '<27><><EFBFBD><EFBFBD> #'+tmp;
      end;
      mainmenu[21] := '<27><><EFBFBD><EFBFBD><EFBFBD>';
      mainmenu[22] := '<27><>室';
     end;

     {Procedura vyvoda zastavki}
     procedure helloscreen;
     begin
      init_screen;
      repeat
       setcolor(7);
       bar(0,0,640,480);
       settextstyle(1, 0, 7);
       {vyvod texta Welcome s tenyu}
       setcolor(green);
       outtextxy(122, y_wlcm+2, welcome);
       setcolor(lightgreen);
       outtextxy(120, y_wlcm, welcome);
       inc(y_wlcm);
       {Vyvod imeni}
       settextstyle(3, 0, 4);
       setcolor(red);
       outtextxy(y_wlcm*2-120, 281, author);
       setcolor(lightred);
       outtextxy(y_wlcm*2-119, 280,author);
       delay(1000);
       {Vyvod nazvania}
       settextstyle(7,0,8);
       setcolor(lightblue);
       for i:= 1 to 6 do
       begin
        if(y_wlcm/16)<i then break;
        outtextxy(80+i*60, 170, javame[i]);
       end;
      until (y_wlcm>100) or (keypressed);
      readkey;
     end;

     {Vyvod info ob avtore}
     procedure author_screen;
      begin;
       init_screen;
       ui('Authors','',9);
       settextstyle(3, 0, 4);
       setcolor(red);
       outtextxy(100, 171, author);
       outtextxy(240, 231, dtpa);
       setcolor(lightred);
       outtextxy(99, 170,author);
       outtextxy(239, 230, dtpa);
       repeat until keypressed;
       menu;
      end;

     {Vyvod pomoschi pri chtenii lekcii}
     procedure help_screen;
      begin;
       init_screen;
       ui('Help','',9);
       setcolor(14);
       settextstyle(2,0,7);
       outtextxy(99, 110, 'UP - <20>⥭<EFBFBD><E2A5AD> <20><><EFBFBD>樨 <20> <20><>砫<EFBFBD>');
       outtextxy(99, 150, 'DOWN - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>࠭<EFBFBD><E0A0AD><EFBFBD>');
       outtextxy(99, 190, 'LEFT/RIGHT - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ⥪<><E2A5AA> <20><><EFBFBD><EFBFBD><EFBFBD>/<2F><>ࠢ<EFBFBD>');
       outtextxy(99, 230, 'ENTER - <20><>ଠ<EFBFBD>쭮<EFBFBD> <20><>ࠢ<EFBFBD><E0A0A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ⥪<><E2A5AA><EFBFBD>');
       outtextxy(99, 270, 'B - <20><><EFBFBD><EFBFBD><EFBFBD> 梥<><E6A2A5> 䮭<>');
       outtextxy(99, 310, 'N - <20><><EFBFBD><EFBFBD><EFBFBD> 梥<><E6A2A5> ⥪<><E2A5AA><EFBFBD>');
       repeat until keypressed;
      end;

      {Procedura otrisovki ekrana}
      procedure ui(ttitle, tbar : string; back : integer);
      begin
      	  {ochistka ekrana}
          setfillstyle(1,back);
          bar(0,0,640,480);
          {Title}
          setfillstyle(1, 1);
          bar(0, 0, 640, 18);
          setcolor(13);
          settextstyle(2,0,6);
          outtextxy(320-TextWidth(title) div 2, 0, ttitle);
          {Status}
          setfillstyle(1, 7);
          settextstyle(2,0,4);
          bar(0, 466, 640, 480);
          setcolor(24);
          outtextxy(10, 468, tbar);
      end;

      {Chtenie strok iz faila}
      procedure readlines;
      var numl : integer;
      begin
      	  numl := 1;
          if not eof(f) then
          begin
            repeat
          	  readln(f, lines[numl]);
      	      inc(numl);
      	    until eof(f) or (numl>(hgt div ch)) or (numl>30);
      	    {Ostalnie zapolnyayem probelami}
      	    for i:= numl to 30 do lines[i] := '';
      	  end;
      end;

      {Chtenie voprosov iz faila}
      procedure readtlines;
      var numl : integer;
      begin
      	  numl := 1;
          if not eof(f) then
          begin
            repeat
              readln(f, test[numl]);
      	      inc(numl);
      	    until eof(f) or (numl>5);
      	  end;
      end;

      {Smena cveta fona}
      procedure changebk;
      begin
      	  inc(cf);
          if(cf=ct) then inc(cf);
          if(cf>16) then cf:=0;
          if(cf=ct) then inc(cf);
      end;

      {Smena cveta teksta}
      procedure changetxt;
      begin
      	  inc(ct);
          if(ct=cf) then inc(ct);
          if(ct>16) then ct:=0;
          if(ct=cf) then inc(ct);
      end;

      {Procedura chtenia lectii}
      procedure lections(var lect:integer);
       begin
        init_screen;
        nolect := lect div 2;
        str(nolect, tmp);
        assign(f, path+'lect'+tmp+'.txt');
        reset(f);
        {Schityvaem nazvanie lekcii}
        readln(f,tmp);
        ch := TextHeight(tmp)+12; {Vysota teksta}
        p1:= '0';
        readlines;
        repeat
          {Obrabotka klavish upravlenia}
          if p1=#72 then begin reset(f); readlines; end{UP}
          else if p1=#80 then readlines {DOWN}
          else if p1=#75 then x:=x-100 {LEFT}
          else if p1=#77 then x:=x+100 {RIGHT}
          else if p1=#13 then x:=0 {ENTER}
          else if p1='b' then changebk {color background}
          else if p1='n' then changetxt; {n - text color}
          ui(tmp,lectstatus,cf);
          {Otrisovka teksta}
          setcolor(ct);
          settextstyle(2,0,5);
          for i:=1 to 30 do
            outtextxy(x,20+i*ch,lines[i]);
          p1:=readkey;
       until (p1=#27) or (p1=#116) or (p1=#59);
       if(p1=#116) then question(lect) {T - Test}
       else if(p1=#59) then help_screen; {F1 - Help}
     end;

     {Procedura testirovania}
     procedure question(var tst:integer);
      var fff: boolean;
            nt: integer; {num of questions}
     begin
        init_screen;
        nolect := tst div 2;
        str(nolect, tmp);
        assign(f, path+'test'+tmp+'.txt');
        reset(f);
        readln(f, nt);
        ch := TextHeight(tmp)+20;
        p1:= '0';
        otv:=0; {Kol-vo pravilnyh otvetov}
        gettime (th,tm,ts,tms);
        t1:=tms+ts*60+tm*3600+th*3600*60; 
        for i:=1 to nt do
         begin
            readtlines;
            repeat
              {Obrabotka klavish upravlenia}
              ui('<27><><EFBFBD><EFBFBD> #'+tmp+' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> '+i,teststatus,cf);
              {Otrisovka teksta}
              setcolor(ct);
              settextstyle(2,0,5);
              for e:=1 to 4 do
                outtextxy(x,20+e*ch,test[e]);
              fff:=false;
              p1:=readkey;
              if p1='b' then changebk {color background}
              else if p1='n' then changetxt {n - text color}
              else if (p1='1') or (p1='2') or (p1='3') then {1,2,3}
                begin
                  if(p1=test[5]) then inc(otv);
                  fff:=true;
                end;
            until fff or (p1=#27) or (p1='l') or (p1=#59);
            if(p1=#27) then break
            else if(p1='l') then lections(tst) {L - Lection}
            else if(p1=#59) then help_screen; {F1 - Help}
        end;
        {End of test}
        gettime (th,tm,ts,tms);
        t2:=tms+ts*60+tm*3600+th*3600*60; 
        if(i=nt) then marks(otv, nt);

     end;

     {Procedura vyvoda ocenok}
     procedure marks(var pr_otv, num_otv: integer);
      var out: string;
            mrk: integer;
      begin
         ui('<27>業<EFBFBD><E6A5AD>','',cf);
         settextstyle(3,0,6);
         setcolor(ct);
         mrk := pr_otv * 100 div num_otv; 
         if(mrk<25) then out:='<27><>㤮<EFBFBD><E3A4AE><EFBFBD>⢮<EFBFBD><E2A2AE>⥫쭮'
         else if(mrk<50) then out:='<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>⢮<EFBFBD><E2A2AE>⥫쭮'
         else if(mrk<75) then out:='<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> =)'
         else out:='<27>ࠢ<EFBFBD>. <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ^_^';
         outtextxy(67,320-TextWidth(out) div 2,out);
         repeat p:=readkey
         until (p=#27);
      end;

     {Procedura obrabotki vibrannogo punkta menu}
     procedure choicemenu(var cur:integer);
      begin
        if(cur=22) then author_screen {AUTHOR}
        else if(cur=23) then halt {EXIT}
        else {OTHER}
        begin
          if cur mod 2=0 then lections(cur)
          else question(cur);
        end;
      end;

     {Procedura vyvoda menu}
     procedure menu;
      begin
        init_screen;
        p := '.';
        repeat
          {Obrabotka klavish upravlenia}
          if p=#72 then cur:=cur-2 {UP}
          else if p=#75 then cur:=cur-1 {LEFT}
          else if p=#80 then cur:=cur+2 {DOWN}
          else if p=#77 then cur:=cur+1 {RIGHT}
          else if p=#13 then choicemenu(cur); {ENTER}
          {Proverka peremennyh}
          if(cur<2) then cur:=2
          else if(cur>23) then cur:=23;
          ui(javame, menustatus,9);
          {Otrisovka menu}
          setcolor(14);
          settextstyle(1,0,3);
          for i:= 1 to 11 do
          begin
             if(i=cur div 2) then
             begin
               setfillstyle(1,3);
               if (cur mod 2=0) then bar(115, 35+i*30, TextWidth(mainmenu[i*2-1])+125, 35+(i+1)*30)
               else bar(315, 35+i*30, TextWidth(mainmenu[i*2])+325, 35+(i+1)*30);
               setfillstyle(1,7);
             end;
          outtextxy(120, 40+i*30, mainmenu[i*2-1]);
          outtextxy(320, 40+i*30, mainmenu[i*2]);
          end;
        p:=readkey;
        until (p=#27);
        halt;
     end;

 {Glavnaya programma}
 begin
    init_variables;
    helloscreen;
    menu;
    closegraph;
 end.