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; {Время} t1,t2, tminim : longint; {Время} ntt, mntt : integer; 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, num_otv: integer); forward; {Procedura inicializacii peremennyh} procedure init_variables; begin cf := 9; ct := 14; x := 20; mntt := 20; hgt := 400; {Vysota svobodnoy oblasti pri vyvode teksta} y_wlcm := -20; cur := 1; tminim := 2000000000; author := 'Автор: Виктор aNNiMON Мельник'; dtpa := 'ДТПА 2ПО-07'; welcome := 'Приветствую'; javame := 'JavaME'; lectstatus := 'F1 - Помощь T - Тест ESC - Меню'; teststatus := 'F1 - Помощь L - Лекции ESC - Меню'; menustatus := 'ESC - Выход UP,DOWN,LEFT,RIGHT - Передвижение курсора ENTER - Переход'; path := 'annimon\'; {Menu Lekcii} for i:= 1 to 10 do begin str(i, tmp); mainmenu[i*2-1] := 'Лекция #'+tmp; mainmenu[i*2] := 'Тест #'+tmp; end; mainmenu[21] := 'Автор'; mainmenu[22] := 'Выход'; 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)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; 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 - Чтение лекции с начала'); outtextxy(99, 150, 'DOWN - Следующая страница'); outtextxy(99, 190, 'LEFT/RIGHT - Сдвинуть текст влево/вправо'); outtextxy(99, 230, 'ENTER - Нормальное выравнивание текста'); outtextxy(99, 270, 'B - Смена цвета фона'); outtextxy(99, 310, 'N - Смена цвета текста'); 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(ttitle) 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} str(i,j); ui('Тест #'+tmp+' Вопрос '+j,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((t2-t1)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.