program pr; uses crt, graph; var tmp_d, tmp_m : integer; {screen variables} p,p1 : char; {readkey} y_wlcm : integer; {Vsplivayushii text} i : integer; {Vspomogatelnie peremennye} cur : integer; {Posicia kursora v menu} x,y, th : 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} javame, author, welcome, dtpa, s, menustatus, tmp, lectstatus,path,j: string; mainmenu : array [1..22] of string; {menu} lines : array [1..30] of string; {readtext} test : array [1..4] 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; {Procedura inicializacii peremennyh} procedure init_variables; begin cf := 9; ct := 14; x := 20; th := 400; {Vysota svobodnoy oblasti pri vyvode teksta} y_wlcm := -20; cur := 1; author := 'Автор: Виктор aNNiMON Мельник'; dtpa := 'ДТПА 2ПО-07'; welcome := 'Приветствую'; javame := 'JavaME'; lectstatus := 'F1 - Помощь T - Тест ESC - Меню'; menustatus := 'ESC - Выход UP,DOWN,LEFT,RIGHT - Передвижение курсора ENTER - Переход'; path := {'Y:\SCHOOL.PAK\2PO-07\'} 'D:\TP\BIN\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; 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 - Чтение лекции с начала'); 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(300, 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>(th 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); begin init_screen; nolect := tst div 2; str(nolect, tmp); assign(f, path+'test'+tmp+'.txt'); reset(f); ch := TextHeight(tmp)+20; p1:= '0'; otv:=0; {Kol-vo pravilnyh otvetov} for i:=1 to 10 do begin readtlines; repeat {Obrabotka klavish upravlenia} if p1='b' then changebk {color background} else if p1='n' then changetxt; {n - text color} if(ord(p1)>48 and ord(p1)<52) then {1,2,3} begin if(p1=test[5]) inc(otv); end; ui(tmp,lectstatus,cf); {Otrisovka teksta} setcolor(ct); settextstyle(2,0,5); for j:=1 to 4 do outtextxy(x,20+j*ch,test[j]); p1:=readkey; until (p1=#27) or (p1='l') or (p1=#59); if(p1='l') then begin break; lections(tst); end; {L - Lecton} if(p1=#59) then begin break; help_screen; end; {F1 - Help} end; {End of test} 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.