
REM ФАЙЛ ДЛЯ РАБОТЫ С ПРЕРЫВАНИЯМИ
'$INCLUDE: 'include\interupt.bi'

REM ОПИСАНИЕ ПРОЦЕДУР

REM DECLARE SUB menu01 (arr%)

DECLARE FUNCTION exist (file$)
DECLARE SUB sel ()
DECLARE SUB sravnenie ()
DECLARE SUB seredina (lines$, dlina%, spase1%)
DECLARE SUB vremia (zader%)
DECLARE SUB char (c$)
DECLARE SUB ramka (X%, Y%, X1%, Y1%, COLOUR%, shrif%)
DECLARE SUB textwindow (stroka0%, stroka%, col%, shrif%)
DECLARE SUB botton ()
DECLARE SUB kodkey (kod%)
DECLARE SUB kursor (j%)
DECLARE SUB press (j%)
DECLARE SUB knopka (j%, Z%, d%, s%)
DECLARE SUB vopros (count%)
DECLARE SUB zastavka ()
DECLARE SUB arrow (arr%, t%, x2%, x3%, maxi%, mini%)
DECLARE SUB menu1 (arr%)
DECLARE SUB oshibki ()
DECLARE SUB menu02 (arr%)
DECLARE SUB struktura ()
DECLARE SUB ten (arr%, n%, col%)
DECLARE SUB kurs (arr%, t%, x2%, x3%, maxi%, mini%)
DECLARE SUB polename (txt1$, txt2$, txt3$, txt4$, niz$)
DECLARE SUB pole (coordx%, coordy%, coordx1%, coordy1%, cvet1%, cvet2%)
DECLARE SUB vvodvopr (b%, c%, kol%, streng$)
DECLARE SUB textpole (b%, c%, kol%, streng$)
DECLARE SUB intter11 ()
DECLARE SUB literatura ()
DECLARE SUB scroll (kx%, ky%, kx1%, ky1%, lin%, back%, dir%)
DECLARE SUB scrolling (coordx%, coordy%, coordx1%, coordy1%, cvet1%, cvet2%, g%, file$)
DECLARE SUB newdata (dd$)
DECLARE SUB viewer ()


REM ОПЕРАТОРЫ ОПИСАНИЯ ПЕРЕМЕННЫХ И КОНСТАНТ

DEFINT A-Z
COMMON SHARED count%, arr%, rab$, variant%, pravotv%, number$, nn%, crit!, ekz%, otm$, otm1$, dds$
DIM SHARED nomera$(100), menu$(12), txt$(80), maxnom(10), vopr$(20), otvets$(10), dano$(41), dat$(20), vibor(11), ris(112)
CONST X = 1, Y = 1, X1 = 25, Y1 = 80, COLOUR% = 9, SHRIFT = 0, TRUE% = -1, FALSE% = 0

rab$ = "ec"
dds$ = MID$(DATE$, 4, 2) + "." + LEFT$(DATE$, 2) + "." + LTRIM$(RIGHT$(DATE$, 2))

RANDOMIZE TIMER

REM НАЧАЛО ПРОГРАММЫ

REM РИСУЕМ ЗАСТАВКУ

CLS
LOCATE , , 0
'SCREEN 12
CALL zastavka

REM Рисуем первое меню

89 :
SCREEN 0
CALL menu1(arr)

REM ПЕРЕКЛЮЧАЕМ ВИДЕОРЕЖИМ УСТАНАВЛИВАЕМ ЦВЕТА И ОЧИЩАЕМ ЭКРАН
REM ЦВЕТУ 6 ПЕРЕНАЗНАЧАЕМ ЦВЕТ 63

SCREEN 0
COLOR 15, 0
CLS
PALETTE 6, 63

REM Первое меню
'CALL menu01(arr%)
'SELECT CASE arr%
'CASE IS = 12
rab$ = "ec"
'CASE IS = 13
'COLOR 15, 0
'CLS
'END
'END SELECT

REM Устанавливаем цвет, чистим экран

COLOR 15, 0
CLS

REM Второе меню
CALL menu02(arr%)

' Очищаем экран

COLOR 15, 0
CLS
IF arr% = 17 THEN
END
END IF

REM Рисуем рамку

CALL ramka(X, Y, X1, Y1, COLOUR, SHRIFT)
LOCATE 19, 1
PRINT "╠" + STRING$(78, "═") + "╣";

REM Вывод вопроса на экран
count = 1: nn = 1: crit = 0
COLOR 14, 1
tmp$ = " В лево - стрелка " + CHR$(27) + "      В право - стрелка " + CHR$(26) + "      Выбор - Enter/Space(пробел) "
LOCATE 19, 2: PRINT tmp$

DO
CALL vopros(count%)
j = 4
CALL knopka(j, 6, 2, 0)
CALL kursor(j)
CALL press(j)
CALL sravnenie
count = count + 1
LOOP WHILE count <= 10

COLOR 15, 0
CLS
SCREEN 12
FOR Z = 0 TO 50
PALETTE 0, 65536 * Z
NEXT
COLOR 10
niz$ = "В ходе тестирования были получены"
CALL seredina(niz$, 80, space%)
LOCATE 13, space%
PRINT niz$
niz$ = "правильные ответы на" + STR$(crit! / .5) + " из 10 вопросов"
CALL seredina(niz$, 80, space%)
LOCATE , space%
PRINT niz$
dd$ = MID$(DATE$, 4, 2) + "." + LEFT$(DATE$, 2) + "." + LTRIM$(STR$(VAL(RIGHT$(DATE$, 2)) + 1))
nizo$ = "Дата следующей сдачи экзамена " + dd$
SELECT CASE cr
       CASE IS = 5
            otm$ = "ОТЛИЧНО"
            otm1$ = otm$ + SPACE$(9)
       CASE IS = 4
            otm$ = "ХОРОШО"
            otm1$ = otm$ + SPACE$(10)
       CASE IS = 3
            otm$ = "УДОВЛЕТВОРИТЕЛЬНО"
            otm1$ = "УДОВЛ." + SPACE$(10)
       CASE ELSE
            otm$ = "НЕУДОВЛЕТВОРИТЕЛЬНО"
            otm1$ = "НЕУДОВЛ." + SPACE$(8)
            mes = VAL(LEFT$(DATE$, 2)) + 1
            IF mes = 13 THEN
               mes = 1
               god$ = STR$(VAL(RIGHT$(DATE$, 2)) + 1)
            ELSE
               god$ = RIGHT$(DATE$, 2)
            END IF
            dd$ = MID$(DATE$, 4, 2) + "." + STR$(mes) + "." + god$
            nizo$ = "Повторная сдача экзамена, не познее: " + dd$
END SELECT
niz$ = "Общая оценка знаний " + otm$
CALL seredina(niz$, 80, space%)
LOCATE , space%
PRINT niz$
CALL seredina(nizo$, 80, space%)
LOCATE 17, space
PRINT nizo$


IF ekz% = 1 THEN

DIM dats$(20)
OPEN "i", #1, "include\config.dat"
FOR wq = 1 TO 20
LINE INPUT #1, dats$(wq)
NEXT
CLOSE

zap$ = LTRIM$((STR$(VAL(dats$(1)) + 1))) + "."
dats$(1) = STR$(VAL(dats$(1)) + 1)

OPEN "o", #1, "include\config.dat"
FOR wq = 1 TO 20
PRINT #1, LTRIM$(dats$(wq))
NEXT
CLOSE

a$ = DATE$
file$ = "jornal\jorn" + RIGHT$(a$, 4)
OPEN "a", #1, file$


sa = LEN(zap$ + dano$(14))
sa = 17 - sa
IF sa < 0 THEN sa = 0

PRINT #1, zap$ + LEFT$(dano$(14), 17) + SPACE$(sa) + "║ " + dano$(17) + "║";
PRINT #1, SPACE$(2) + MID$(DATE$, 4, 2) + "." + LEFT$(DATE$, 2) + "." + RIGHT$(DATE$, 2) + "," + SPACE$(3) + "║";
PRINT #1, otm1$ + "║" + SPACE$(8) + "║";
PRINT #1, MID$(DATE$, 4, 2) + "." + LEFT$(DATE$, 2) + "." + LTRIM$(STR$(VAL(RIGHT$(DATE$, 2)) + 1))

sa = LEN(dano$(15)) + 2
sa = 17 - sa
IF sa < 0 THEN sa = 0
sb = LEN(dano$(18))
sb = 9 - sb
IF sb < 0 THEN sb = 0
sc = LEN(dano$(20))
sc = 14 - sc
IF sc < 0 THEN sc = 0

PRINT #1, SPACE$(2) + LEFT$(dano$(15), 17) + SPACE$(sa) + "║" + LEFT$(dano$(18), 9) + SPACE$(sb) + "║";
PRINT #1, LEFT$(dano$(20), 15) + SPACE$(sc) + "║";
SELECT CASE arr%
CASE 6 TO 8
PRINT #1, "V группа" + SPACE$(8) + "║";
CASE 9, 15, 14
PRINT #1, "IV группа" + SPACE$(7) + "║";
CASE 10 TO 13
PRINT #1, "V группа" + SPACE$(8) + "║";
CASE IS = 16
PRINT #1, "III группа" + SPACE$(6) + "║";
END SELECT
PRINT #1, SPACE$(8) + "║"

group$ = " группа"
sa = LEN(dano$(16)) + 2
sa = 17 - sa
IF sa < 0 THEN sa = 0
sb = LEN(dano$(19)) + 7
sb = 9 - sb
IF sb < 0 THEN
sb = 0
group$ = " гр.  "
END IF

PRINT #1, SPACE$(2) + LEFT$(dano$(16), 17) + SPACE$(sa) + "║" + LEFT$(dano$(19), 9) + group$ + SPACE$(sb) + "║";
PRINT #1, SPACE$(14) + "║до и выше 1000 В║" + SPACE$(8) + "║"

sa = LEN(dano$(13)) + 2
sa = 17 - sa
IF sa < 0 THEN sa = 0

PRINT #1, SPACE$(2) + LEFT$(dano$(13), 17) + SPACE$(sa) + "║до и выше║";
PRINT #1, SPACE$(14) + "║                ║" + SPACE$(8) + "║"

PRINT #1, SPACE$(17); "║  1000 В ║" + SPACE$(14) + "║                ║" + SPACE$(8) + "║"

PRINT #1, STRING$(17, "═") + "╩" + STRING$(9, "═") + "╩";
PRINT #1, STRING$(14, "═") + "╩" + STRING$(16, "═") + "╩" + STRING$(8, "═");
PRINT #1, "╩" + STRING$(9, "═")

PRINT #1, " Председатель комиссии: " + dano$(1) + " " + dano$(2) + " ";
PRINT #1, LTRIM$(LEFT$(dano$(3), 1)) + "." + LTRIM$(LEFT$(dano$(4), 1)) + "."
PRINT #1, "       Члены комиссии: " + dano$(5) + " " + dano$(6) + " ";
PRINT #1, LTRIM$(LEFT$(dano$(7), 1)) + "." + LTRIM$(LEFT$(dano$(8), 1)) + "."
PRINT #1, "                       " + dano$(9) + " " + dano$(10) + " ";
PRINT #1, LTRIM$(LEFT$(dano$(11), 1)) + "." + LTRIM$(LEFT$(dano$(12), 1)) + "."

PRINT #1, STRING$(17, "═") + "╦" + STRING$(9, "═") + "╦";
PRINT #1, STRING$(14, "═") + "╦" + STRING$(16, "═") + "╦" + STRING$(8, "═");
PRINT #1, "╦" + STRING$(9, "═")

CLOSE

END IF

CALL kodkey(kod)

CLS
FOR Z = 50 TO 0 STEP -1
PALETTE 0, 65536 * Z
NEXT

IF cr <> 5 THEN

FOR Z = 0 TO 50
PALETTE 0, 65536 * Z
NEXT
CALL pole(1, 1, 30, 80, 14, 14)
COLOR 10
'niz$ = "Разделы, в которых были допущены ошибки,"
niz$ = "Работа над ошибками"
CALL seredina(niz$, 80, space%)
LOCATE 15, space
PRINT niz$
'niz$ = "выделены желтым цветом"
'CALL seredina(niz$, 80, space%)
'LOCATE 15, space
'PRINT niz$

DO: LOOP WHILE INKEY$ = ""
CLS
FOR Z = 50 TO 0 STEP -1
PALETTE 0, 65536 * Z
NEXT

'SCREEN 0
'CALL struktura

'FOR dbf = 1 TO nn - 1
'file$ = MID$(otvets$(dbf), 2, 1)
'IF file$ = "1" THEN
'IF MID$(otvets$(dbf), 2, 2) = "10" THEN file$ = "10"
'END IF

'COLOR 14, 9

'SELECT CASE file$

'CASE IS = "1"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(3, gfh))
'LOCATE 3, gfh: PRINT simb$
'NEXT
'CASE IS = "2"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(4, gfh))
'LOCATE 4, gfh: PRINT simb$
'NEXT
'CASE IS = "3"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(5, gfh))
'LOCATE 5, gfh: PRINT simb$
'NEXT
'CASE IS = "4"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(6, gfh))
'LOCATE 6, gfh: PRINT simb$
'NEXT
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(7, gfh))
'LOCATE 7, gfh: PRINT simb$
'NEXT
'CASE IS = "5"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(8, gfh))
'LOCATE 8, gfh: PRINT simb$
'NEXT
'CASE IS = "6"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(9, gfh))
'LOCATE 9, gfh: PRINT simb$
'NEXT
'CASE IS = "7"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(10, gfh))
'LOCATE 10, gfh: PRINT simb$
'NEXT
'CASE IS = "8"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(11, gfh))
'LOCATE 11, gfh: PRINT simb$
'NEXT
'CASE IS = "9"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(12, gfh))
'LOCATE 12, gfh: PRINT simb$
'NEXT
'CASE IS = "10"
'FOR gfh = 3 TO 77
'simb$ = CHR$(SCREEN(13, gfh))
'LOCATE 13, gfh: PRINT simb$
'NEXT

'END SELECT
'NEXT
'DO: LOOP WHILE INKEY$ = ""
'SOUND 500, .5

CALL oshibki
GOTO 89
END IF

END

SUB arrow (arr%, t%, x2%, x3%, maxi%, mini%)

REM процедура рисует стрелочки в меню

FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 7)
NEXT

arr = arr + t
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT

IF arr > maxi THEN
arr = mini
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr + t, n, 7)
NEXT
COLOR 15, 1
LOCATE maxi, x2
PRINT CHR$(32)
LOCATE maxi, x3
PRINT CHR$(32)
END IF

IF arr < mini THEN
arr = maxi
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr + t, n, 7)
NEXT
COLOR 15, 1
LOCATE mini, x3
PRINT CHR$(32)
LOCATE mini, x2
PRINT CHR$(32)
END IF

COLOR 15, 1
LOCATE arr, x2
PRINT CHR$(16)
COLOR 15, 1
LOCATE arr, x3
PRINT CHR$(17)
COLOR 15, 1
IF t = 0 THEN EXIT SUB
LOCATE arr - t, x2
PRINT CHR$(32)
COLOR 15, 1
LOCATE arr - t, x3
PRINT CHR$(32)

END SUB

SUB botton

j = 4
DO
COLOR 0, 3
LOCATE 20, j
PRINT "╔" + STRING$(12, "═") + "╗";
FOR i = 21 TO 23
LOCATE i, j
PRINT "║" + SPACE$(12) + "║";
NEXT i
LOCATE 24, j
PRINT "╚" + STRING$(12, "═") + "╝";
Z = 7
d = 2
s = 0
CALL knopka(j, Z, d, s)
COLOR 0, 3
LOCATE 22, j + 11
PRINT "▄"
LOCATE 23, j + 3
PRINT STRING$(9, "▀")
j = j + 20
LOOP WHILE j < 65
COLOR 15, 0

END SUB

SUB char (c$)

n = &H16:
inreg.ax = 0
CALL Interrupt(n, inreg, outreg)
nah = outreg.ax \ 256: nal = outreg.ax MOD 256
c$ = CHR$(nal): IF nal = 0 THEN c$ = c$ + CHR$(nah)


END SUB

FUNCTION exist (file$)

nf = FREEFILE
OPEN file$ FOR BINARY AS #nf
IF LOF(nf) > 0 THEN
CLOSE #nf
exist = TRUE%
ELSE
CLOSE #nf
KILL file$
exist = FALSE%
END IF

END FUNCTION

SUB intter11

REM процедура для защиты от копирования
strengs$ = "": pas$ = "": pass$ = "": pass2$ = ""
OPEN "i", #1, "include\config.dat"
FOR c = 1 TO 4
LINE INPUT #1, p$
NEXT
LINE INPUT #1, pas$
pass$ = pass$ + pas$
LINE INPUT #1, p$
LINE INPUT #1, pas$
pass2$ = pass$ + pas$ + ":"
pass$ = pass$ + pas$ + "-"
LINE INPUT #1, p$
LINE INPUT #1, pas$
pass$ = pass$ + pas$
pass2$ = pass2$ + pas$
LINE INPUT #1, p$
LINE INPUT #1, pas$
pass$ = pass$ + pas$
pass2$ = pass2$ + pas$
CLOSE #1
SHELL "dir .exe > c:\tmp.tmp"
OPEN "i", #1, "c:\tmp.tmp"

DO WHILE NOT EOF(1)
LINE INPUT #1, strings$
nom% = INSTR(strings$, pass$)
IF nom% > 0 THEN
   zlak = 1
   EXIT DO
END IF
nom% = INSTR(strings$, pass2$)
IF nom% > 0 THEN
   zlak = 1
   EXIT DO
END IF

LOOP

CLOSE #1

IF pass$ = "" THEN zlak = 2

'IF zlak <> 1 THEN
'SCREEN 0
'COLOR 15, 0
'CLS
'END
'END IF
KILL "c:\tmp.tmp"
IF zlak <> 1 THEN
SCREEN 0
COLOR 15, 0
CLS
COLOR 10
PRINT "Unregistred copy"
END
END IF


END SUB

SUB knopka (j, Z, d, s)

botton1$ = CHR$(16) + SPACE$(3)
botton2$ = SPACE$(3) + CHR$(17)
COLOR 0, Z
LOCATE 22, j + d
qw = ((j + 16) / 20) + s
SELECT CASE qw
CASE IS = 1
d$ = "а"
CASE IS = 2
d$ = "б"
CASE IS = 3
d$ = "в"
CASE IS = 4
d$ = "г"
END SELECT
PRINT botton1$; d$; botton2$

END SUB

SUB kodkey (kod)

DO: LOOP WHILE INKEY$ <> ""
DO
a$ = ""
DO: a$ = INKEY$: LOOP WHILE a$ = ""
IF LEN(a$) = 1 THEN
        IF a$ = CHR$(13) THEN kod = 13: EXIT DO
        IF a$ = " " THEN kod = 32: EXIT DO
        IF a$ = CHR$(27) THEN kod = 27: EXIT DO

ELSE
        kod = ASC(RIGHT$(a$, 1))
        IF kod = 68 OR kod = 59 OR kod = 72 OR kod = 75 OR kod = 77 OR kod = 80 THEN EXIT DO
END IF
LOOP

END SUB

SUB kurs (arr%, t%, x2%, x3%, maxi%, mini%)

DO
CALL kodkey(kod)
SELECT CASE kod
CASE IS = 32
SOUND 500, .5
EXIT DO
CASE IS = 13
SOUND 500, .5
EXIT DO
CASE IS = 72
SOUND 200, .5
t = -1
CASE IS = 80
SOUND 200, .5
t = 1
CASE ELSE
t = 0
END SELECT
CALL arrow(arr%, t%, x2%, x3%, maxi%, mini%)
LOOP

END SUB

SUB kursor (j)

LOCATE , , 0
DO
1 :
CALL kodkey(kod)
SELECT CASE kod
CASE IS = 75
j = j - 20
IF j < 4 THEN
j = 4
GOTO 1
END IF
Z = 6
d = 2
s = 0
CALL knopka(j, Z, d, s)
Z = 7
d = 22
s = 1
CALL knopka(j, Z, d, s)
SOUND 200, .5
CASE IS = 77
j = j + 20
IF j > 64 THEN
j = 64
GOTO 1
END IF
Z = 6
d = 2
s = 0
CALL knopka(j, Z, d, s)
Z = 7
d = -18
s = -1
CALL knopka(j, Z, d, s)
SOUND 200, .5
CASE IS = 32
IF j = 4 THEN variant = 1
IF j = 24 THEN variant = 2
IF j = 44 THEN variant = 3
IF j = 64 THEN variant = 4
SOUND 500, .5
EXIT DO
CASE IS = 13
IF j = 4 THEN variant = 1
IF j = 24 THEN variant = 2
IF j = 44 THEN variant = 3
IF j = 64 THEN variant = 4
SOUND 500, .5
EXIT DO
CASE ELSE
END SELECT
LOOP

END SUB

SUB literatura

CLS
col = 9
CALL ramka(X, Y, X1, Y1, col, 0)
stroka = 24: col = 9
CALL textwindow(2, 24, 9, 15)
LOCATE 3, 5
PRINT "1. Правила устройства электроустановок./Минэнерго СССР. ─ 6-е изд. ─ М.:"
LOCATE , 8
PRINT "Энергоатомиздат, 1986. ─ 648с."
LOCATE , 5
PRINT "2. Правила технической эксплуатации железных дорог Российской Федерации:"
LOCATE , 8
PRINT "─ М.: Транспорт, 1993. ─ 160c."
LOCATE , 5
PRINT "3. Правила технической эксплуатации электроустановок потребителей и "
LOCATE , 8
PRINT "Правила техники безопасности при эксплуатации электроустановок потре-"
LOCATE , 8
PRINT "бителей. ─ 4-е изд.,перераб. и доп. ─ Энергоатомиздат, 1996. ─ 424с."
LOCATE , 5
PRINT "4. Правила эксплуатации электроустановок потребителей./Госэнергонадзор "
LOCATE , 8
PRINT "─ 5-е изд. перераб. и доп. ─ М.: Энергоатомиздат, 1993. ─ 288с."
LOCATE , 5
PRINT "5. ЦЭ/39 от 30.06.92г. с исправлениями ЭЭ-52/713 от 03.12.93г. Инструк-"
LOCATE , 8
PRINT "ция по техническому обслуживанию и ремонту оборудования тяговых под-"
LOCATE , 8
PRINT "станций, пунктов питания и секционирования электрифицированных желез- "
LOCATE , 8
PRINT "ных дорог. М., Издательский дом ЮДЖИ, 1993.─ 93с."
LOCATE , 5
PRINT "6. ЦЭ/4874 от 18.11.91г. Инструкция по оперативному обслуживанию тяговых"
LOCATE , 8
PRINT "подстанций электрифицированных железных дорог. М.:Транспорт, 1992,17c."
LOCATE , 5
PRINT "7. Правила применения и испытания средств защиты, используемых в элек-"
LOCATE , 8
PRINT "троустановках, технические требования к ним. М.: Москва, 1993 ,72c."
DO: LOOP WHILE INKEY$ = ""
SOUND 500, .5

END SUB

SUB menu01 (arr%)

REM ПЕРВОЕ МЕНЮ

CALL ramka(10, 17, 15, 62, 1, 0)

t = 0: arr = 12: x2 = 19: x3% = 60: maxi = 13: mini = 12
CALL arrow(arr%, t%, x2, x3, maxi, mini)

COLOR 15, 1
menu$(1) = "Тест для работников района электроснабжения"
menu$(2) = "Выход"
CALL seredina(menu$(1), 80, space1%)
LOCATE 12, space1%
PRINT menu$(1)
COLOR 7, 1
CALL seredina(menu$(2), 80, space1%)
LOCATE , space1%
PRINT menu$(2)
niz$ = "Выберите категорию работников и нажмите пробел."
CALL seredina(niz$, 80, space1%)
LOCATE 25, space1%
COLOR 15, 0
PRINT niz$;

CALL kurs(arr%, t%, x2%, x3%, maxi%, mini%)

END SUB

SUB menu02 (arr%)

REM ВТОРОЕ МЕНЮ

CALL ramka(4, 4, 19, 75, 1, 0)

t = 0: arr% = 6: x2% = 6: x3% = 73: maxi% = 17: mini% = 6
CALL arrow(arr%, t%, x2%, x3%, maxi%, mini%)
menu$(1) = "Тест начальника района электроснабжения V группы"
menu$(2) = "Тест старшего электромеханика, механика V группы"
menu$(3) = "Тест электромонтера по обслуживанию ВЛ и ТП V группы"
menu$(4) = "Тест электромонтера по обслуживанию ВЛ и ТП IV группы"
menu$(5) = "Тест электромонтера с правом дежурства и в/в испытаний V группы"
menu$(6) = "Тест электромонтера с правом в/в испытаний V группы"
menu$(7) = "Тест электромонтера с правом дежурства V группы"
menu$(8) = "Тест электромонтера V группы"
menu$(9) = "Тест электромонтера с правом дежурства IV группы"
menu$(10) = "Тест электромонтера IV группы"
menu$(11) = "Тест электромонтера, контролер-монтер III группы"
menu$(12) = "Выход"
COLOR 15, 1
CALL seredina(menu$(1), 80, space1%)
LOCATE 6, space1%
PRINT menu$(1)
COLOR 7, 1
CALL seredina(menu$(2), 80, space1%)
LOCATE , space1%
PRINT menu$(2)
CALL seredina(menu$(3), 80, space1%)
LOCATE , space1%
PRINT menu$(3)
CALL seredina(menu$(4), 80, space1%)
LOCATE , space1%
PRINT menu$(4)
CALL seredina(menu$(5), 80, space1%)
LOCATE , space1%
PRINT menu$(5)
CALL seredina(menu$(6), 80, space1%)
LOCATE , space1%
PRINT menu$(6)
CALL seredina(menu$(7), 80, space1%)
LOCATE , space1%
PRINT menu$(7)
CALL seredina(menu$(8), 80, space1%)
LOCATE , space1%
PRINT menu$(8)
CALL seredina(menu$(9), 80, space1%)
LOCATE , space1%
PRINT menu$(9)
CALL seredina(menu$(10), 80, space1%)
LOCATE , space1%
PRINT menu$(10)
CALL seredina(menu$(11), 80, space1%)
LOCATE , space1%
PRINT menu$(11)
CALL seredina(menu$(12), 80, space1%)
LOCATE , space1%
PRINT menu$(12)
niz$ = "Выберите группу по электробезопасности и нажмите пробел."
CALL seredina(niz$, 80, space1%)
LOCATE 25, space1%
COLOR 15, 0
PRINT niz$;

CALL kurs(arr%, t%, x2%, x3%, maxi%, mini%)

END SUB

SUB menu1 (arr%)

REM МЕНЮ

6 :
CALL ramka(7, 18, 17, 61, 1, 0)

t = 0: arr = 9: x2 = 20: x3% = 59: maxi = 15: mini = 9: ekz = 0
CALL arrow(arr%, t%, x2, x3, maxi, mini)

COLOR 15, 1
menu$(1) = "Сдача экзаменов"
menu$(2) = "Тестирование"
menu$(3) = "Просмотр журнала"
menu$(4) = "Структура билета и список литературы"
menu$(5) = "Редактирование вопросов"
menu$(6) = "Помощь"
menu$(7) = "Выход"
CALL seredina(menu$(1), 80, space1%)
LOCATE 9, space1%
PRINT menu$(1)
COLOR 7, 1
CALL seredina(menu$(2), 80, space1%)
LOCATE , space1%
PRINT menu$(2)
CALL seredina(menu$(3), 80, space1%)
LOCATE , space1%
PRINT menu$(3)
CALL seredina(menu$(4), 80, space1%)
LOCATE , space1%
PRINT menu$(4)
CALL seredina(menu$(5), 80, space1%)
LOCATE , space1%
PRINT menu$(5)
CALL seredina(menu$(6), 80, space1%)
LOCATE , space1% + 1
PRINT menu$(6)
CALL seredina(menu$(7), 80, space1%)
LOCATE , space1%
PRINT menu$(7)

CALL kurs(arr%, t%, x2%, x3%, maxi%, mini%)

'SCREEN 12
SELECT CASE arr
CASE IS = 9
SCREEN 12
REM СДАЧА ЭКЗАМЕНА

REM Создание журнала
a$ = DATE$
file$ = "jornal\jorn" + RIGHT$(a$, 4)
IF exist(file$) THEN
ELSE
DIM datas$(20)
OPEN "i", #1, "include\config.dat"
FOR wq = 1 TO 20
LINE INPUT #1, datas$(wq)
NEXT
CLOSE

datas$(1) = "0"

OPEN "o", #1, "include\config.dat"
FOR wq = 1 TO 20
PRINT #1, LTRIM$(datas$(wq))
NEXT
CLOSE

OPEN "o", #1, file$
PRINT #1, STRING$(17, "═") + "╦" + STRING$(9, "═") + "╦";
PRINT #1, STRING$(14, "═") + "╦" + STRING$(16, "═") + "╦" + STRING$(8, "═");
PRINT #1, "╦" + STRING$(9, "═")
PRINT #1, "  Фамилия, имя,  " + "║" + "   Дата  " + "║" + "Дата и причина" + "║";
PRINT #1, " Общая  оценка  " + "║" + " Подпись" + "║" + "Дата сле-"

PRINT #1, "отчество,занимае-" + "║" + " предыду-" + "║" + "   проверки   " + "║";
PRINT #1, "знаний,группа по" + "║" + "проверя-" + "║" + "  дующей "

PRINT #1, " мая должность и " + "║" + " щей про-" + "║" + "              " + "║";
PRINT #1, " электробезопас-" + "║" + "  емого " + "║" + " проверки"

PRINT #1, " стаж  работы  в " + "║" + "  верки, " + "║" + "              " + "║";
PRINT #1, "ности и заключе-" + "║" + "  лица  " + "║" + "         "
PRINT #1, "  этой должности " + "║" + "  оценка " + "║" + "              " + "║";
PRINT #1, "   ние комиссии " + "║" + "        " + "║" + "         "

PRINT #1, "                 " + "║" + " знаний и" + "║" + "              " + "║";
PRINT #1, "                " + "║" + "        " + "║" + "         "

PRINT #1, "                 " + "║" + "группа по" + "║" + "              " + "║";
PRINT #1, "                " + "║" + "        " + "║" + "         "

PRINT #1, "                 " + "║" + " электро-" + "║" + "              " + "║";
PRINT #1, "                " + "║" + "        " + "║" + "         "

PRINT #1, "                 " + "║" + " безопас-" + "║" + "              " + "║";
PRINT #1, "                " + "║" + "        " + "║" + "         "

PRINT #1, "                 " + "║" + "  ности  " + "║" + "              " + "║";
PRINT #1, "                " + "║" + "        " + "║" + "         "

PRINT #1, STRING$(17, "═") + "╬" + STRING$(9, "═") + "╬";
PRINT #1, STRING$(14, "═") + "╬" + STRING$(16, "═") + "╬" + STRING$(8, "═");
PRINT #1, "╬" + STRING$(9, "═")
END IF

'Вводим данные о составе экзаменационной комиссии
SCREEN 12
txt1$ = "Занимаемая должность"
txt2$ = "Фамилия"
txt3$ = "Имя"
txt4$ = "Отчество"
niz$ = "Председатель комиссии"
CALL polename(txt1$, txt2$, txt3$, txt4$, niz$)
dano$(1) = txt1$
dano$(2) = txt2$
dano$(3) = txt3$
dano$(4) = txt4$
txt1$ = "Занимаемая должность"
txt2$ = "Фамилия"
txt3$ = "Имя"
txt4$ = "Отчество"
niz$ = "Члены комиссии"
CALL polename(txt1$, txt2$, txt3$, txt4$, niz$)
dano$(5) = txt1$
dano$(6) = txt2$
dano$(7) = txt3$
dano$(8) = txt4$
txt1$ = "Занимаемая должность"
txt2$ = "Фамилия"
txt3$ = "Имя"
txt4$ = "Отчество"
niz$ = "Члены комиссии"
CALL polename(txt1$, txt2$, txt3$, txt4$, niz$)
dano$(9) = txt1$
dano$(10) = txt2$
dano$(11) = txt3$
dano$(12) = txt4$

REM РИСУЕМ ПОЛЯ ДЛЯ ВВОДА ДАННЫХ О ЭКЗАМЕНУЕМОМ
niz$ = "Введите данные тестируемого и нажмите ENTER"
txt1$ = "Занимаемая должность"
txt2$ = "Фамилия"
txt3$ = "Имя"
txt4$ = "Отчество"
CALL polename(txt1$, txt2$, txt3$, txt4$, niz$)
dano$(13) = txt1$
dano$(14) = txt2$
dano$(15) = txt3$
dano$(16) = txt4$
niz$ = "Введите данные тестируемого и нажмите ENTER"
txt1$ = "Дата предыдущей проверки дд.мм.гг"
txt2$ = "Оценка знаний предыдущей проверки"
txt3$ = "Группа по электробезопасности"
txt4$ = "Причина проверки"
CALL polename(txt1$, txt2$, txt3$, txt4$, niz$)
dano$(17) = txt1$
dano$(18) = txt2$
dano$(19) = txt3$
dano$(20) = txt4$

ekz = 1

CASE IS = 10
SCREEN 0
REM ТЕСТИРОВАНИЕ

CASE IS = 11
SCREEN 12
REM ПРОСМОТР ЖУРНАЛА

fil$ = ""
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
DO WHILE LEN(fil$) <> 4
CLS
CALL pole(6, 4, 25, 76, 15, 7)
CALL pole(14, 25, 16, 55, 7, 15)
COLOR 15
LOCATE 15, 27
LINE INPUT "За какой год журнал ? ", fil$
file$ = "jornal\jorn" + fil$
IF NOT exist(file$) THEN
CLS
CALL pole(6, 4, 25, 76, 15, 7)
CALL pole(14, 25, 16, 56, 7, 15)
COLOR 15
LOCATE 15, 27
PRINT "Журнал за этот год не найден"
niz$ = "Для создания нового файла нажмите 'ENTER',"
CALL seredina(niz$, 80, space%)
LOCATE 22, space%
PRINT niz$
niz$ = "для выхода в меню 'ESC'"
CALL seredina(niz$, 80, space%)
LOCATE 23, space%
PRINT niz$
56789 :
CALL kodkey(kod)
SELECT CASE kod
CASE 13
EXIT DO
CASE 27
SCREEN 0
GOTO 6
CASE ELSE
GOTO 56789
END SELECT

fil$ = SPACE$(32)
END IF
LOOP

SCREEN 0
SHELL "wd\wd.exe " + file$
GOTO 6

CASE IS = 12
SCREEN 0
CALL struktura
DO: LOOP WHILE INKEY$ = ""
SOUND 500, .5

CALL literatura
COLOR 15, 0
CLS
GOTO 6

CASE IS = 13
SCREEN 12
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT

CALL pole(6, 4, 25, 76, 15, 7)
COLOR 15
LOCATE 8, 10
PRINT "Для редактирования вопроса потребуется ввести номер раздела"
LOCATE , 10
PRINT "Если вы хотите просмотреть список  разделов сейчас, то наж-"
LOCATE , 10
PRINT "мите ";
COLOR 10
PRINT "'ENTER'";
COLOR 15
PRINT ", чтобы продолжить без просмотра нажмите ";
COLOR 10
PRINT "'ESC'."
COLOR 15
LOCATE , 10
PRINT ""
LOCATE , 10
PRINT "Каждый вопрос должен иметь четыре варианта ответов, начина-"
LOCATE , 10
PRINT "ющихся соответственно с ";
COLOR 10
PRINT "а), б), в) и г).";
COLOR 15
PRINT " Из них три вариан-"
LOCATE , 10
PRINT "та должны быть неправильными."
LOCATE , 10
PRINT ""
LOCATE , 10
PRINT "Для  того чтобы  закончить ввод  вопроса необходимо  нажать"
COLOR 10
LOCATE , 10
PRINT "'F10'";
COLOR 15
PRINT " и сохранить набранный текст в файл";
COLOR 10
PRINT " 'redaktor'."
COLOR 15
LOCATE , 10
PRINT ""
LOCATE , 10
LOCATE , 10
PRINT "Для получения более подробной  информации смотрите докумен-"
LOCATE , 10
PRINT "тацию."
PRINT ""
LOCATE , 10
PRINT ""
LOCATE , 10
PRINT ""

DO: a$ = INKEY$
IF a$ = CHR$(13) THEN
SCREEN 0
CALL struktura
DO: LOOP WHILE INKEY$ = ""
SOUND 500, .5

SCREEN 12
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
EXIT DO
ELSEIF a$ = CHR$(27) THEN EXIT DO
END IF
LOOP
CLS
CALL pole(6, 4, 25, 76, 15, 7)
CALL pole(14, 28, 16, 55, 7, 15)
COLOR 15
LOCATE 15, 30
LINE INPUT "Введите номер раздела ", file$
DO WHILE VAL(file$) > 11 OR VAL(file$) = 0
LOCATE 15, 49
PRINT SPACE$(3)
LOCATE 15, 30
LINE INPUT "Введите номер раздела ", file$
LOOP

OPEN "i", #1, "ptb\party_" + file$ + ".ptb"
k = 1: p = 1
DO WHILE NOT EOF(1)
LINE INPUT #1, st$
first% = INSTR(st$, " " + file$ + ".")

IF first > 0 THEN
nom$ = MID$(st$, first + LEN(file$) + 2, p)
END IF
posl = VAL(nom$)
IF posl = 9 THEN p = 2
IF posl = 99 THEN p = 3
k = k + 1
LOOP
CLOSE

OPEN "i", #1, "include\config.dat"
FOR wq = 1 TO 20
LINE INPUT #1, dat$(wq)
NEXT
CLOSE

ew = VAL(file$) * 2
dat$(ew) = STR$(posl + 1)

OPEN "o", #1, "include\config.dat"
FOR wq = 1 TO 20
PRINT #1, LTRIM$(dat$(wq))
NEXT
CLOSE

rab$ = "ec"
OPEN "a", #1, "ptb\party_" + file$ + ".ptb"
PRINT #1, " " + file$ + "." + LTRIM$(STR$(posl + 1)) + SPACE$(4) + rab$ + "(";

CLS
FOR Z = 35 TO 0 STEP -1
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT

CALL pole(5, 4, 26, 76, 15, 7)
CALL pole(10, 6, 24, 74, 7, 15)

COLOR 10
niz$ = "Если вопрос следует задавать данной категории работников"
CALL seredina(niz$, 80, space1%)
LOCATE 7, space1%
PRINT niz$;
niz$ = "нажмите 'ENTER', если нет то 'ESC'."
CALL seredina(niz$, 80, space1%)
LOCATE 8, space1%
PRINT niz$;

menu$(1) = "Тест начальника района электроснабжения V группы"
menu$(2) = "Тест старшего электромеханика, механика V группы"
menu$(3) = "Тест электромонтера по обслуживанию ВЛ и ТП V группы"
menu$(4) = "Тест электромонтера по обслуживанию ВЛ и ТП IV группы"
menu$(5) = "Тест электромонтера с правом дежурства и в/в испытаний V группы"
menu$(6) = "Тест электромонтера с правом в/в испытаний V группы"
menu$(7) = "Тест электромонтера с правом дежурства V группы"
menu$(8) = "Тест электромонтера V группы"
menu$(9) = "Тест электромонтера с правом дежурства IV группы"
menu$(10) = "Тест электромонтера IV группы"
menu$(11) = "Тест электромонтера, контролер-монтер III группы"

COLOR 15
LOCATE 12, 8
PRINT menu$(1)
LOCATE 12, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 13, 8
PRINT menu$(2)
LOCATE 13, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 14, 8
PRINT menu$(3)
LOCATE 14, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 15, 8
PRINT menu$(4)
LOCATE 15, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 16, 8
PRINT menu$(5)
LOCATE 16, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 17, 8
PRINT menu$(6)
LOCATE 17, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 18, 8
PRINT menu$(7)
LOCATE 18, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 19, 8
PRINT menu$(8)
LOCATE 19, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 20, 8
PRINT menu$(9)
LOCATE 20, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 21, 8
PRINT menu$(10)
LOCATE 21, 70
CALL sel
PRINT #1, ",";

COLOR 15
LOCATE 22, 8
PRINT menu$(11)
LOCATE 22, 70
CALL sel
PRINT #1, ")";

DO: LOOP WHILE INKEY$ = ""

DO
CLS
CALL pole(13, 4, 17, 76, 15, 7)
CALL pole(14, 69, 16, 73, 7, 15)
LOCATE 15, 10
PRINT "Введите номер правильного ответа (цифра от 1 до 4):"
LOCATE 15, 71
INPUT "", pr%
LOOP WHILE pr > 4 AND pr < 1
PRINT #1, SPACE$(2) + STR$(pr)

CLS
FOR Z = 35 TO 0 STEP -1
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
CALL pole(6, 4, 25, 76, 15, 7)
CALL pole(14, 31, 16, 49, 7, 15)
COLOR 15
niz$ = "Введите вопрос."
CALL seredina(niz$, 80, space1%)
LOCATE 15, space1%
PRINT niz$;

DO: LOOP WHILE INKEY$ <> ""

DO: LOOP WHILE INKEY$ = ""

SCREEN 0
CLOSE

OPEN "o", #1, "redaktor"
CLOSE

1234 :
SHELL "wd\wd.exe redaktor"

bu = 1
OPEN "i", #1, "redaktor"
DO WHILE NOT EOF(1)
LINE INPUT #1, vop$
bu = bu + 1
IF INSTR(vop$, "(*") > 0 THEN
bu = bu - 1
GOTO 564
END IF
IF LEN(vop$) > 72 THEN
LOCATE 1, 1
PRINT "Слишком длинная строка"
END IF
564 :
IF bu > 19 THEN
LOCATE 1, 1
PRINT "Вопрос слишком большой. Количество строк должно быть не более 18."
LOCATE 2, 1
PRINT "Отредактируйте его вновь."
DO: LOOP WHILE INKEY$ = ""
CLOSE
GOTO 1234
END IF
LOOP
CLOSE

OPEN "i", #1, "redaktor"
OPEN "a", #2, "ptb\party_" + file$ + ".ptb"
DO WHILE NOT EOF(1)
LINE INPUT #1, vop$
IF INSTR(vop$, "(*") <= 0 THEN PRINT #2, vop$
LOOP
CLOSE

KILL "redaktor"

OPEN "a", #1, "ptb\party_" + file$ + ".ptb"
PRINT #1, " ~"
CLOSE

SCREEN 12
CLS
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
CALL pole(6, 4, 25, 76, 15, 7)
CALL pole(14, 15, 16, 65, 7, 15)
COLOR 15
niz$ = "Введите ответ в соответствии с первоисточником."
CALL seredina(niz$, 80, space1%)
LOCATE 15, space1%
PRINT niz$;

DO: LOOP WHILE INKEY$ = ""

DO: LOOP WHILE INKEY$ <> ""

SCREEN 0

OPEN "a", #1, "ptb\party_" + file$ + ".ptb"
PRINT #1, " !"
CLOSE

OPEN "o", #1, "redaktor"
CLOSE

12345 :
SHELL "wd\wd.exe redaktor"

bu = 1
OPEN "i", #1, "redaktor"
DO WHILE NOT EOF(1)
LINE INPUT #1, vop$
bu = bu + 1
IF INSTR(vop$, "(*") > 0 THEN
bu = bu - 1
GOTO 345
END IF
IF LEN(vop$) > 72 THEN
LOCATE 1, 1
PRINT "Слишком длинная строка"
DO: LOOP WHILE INKEY$ = ""
END IF
345 :
IF bu > 19 THEN
LOCATE 1, 1
PRINT "Ответ слишком большой. Количество строк должно быть не более 18."
LOCATE 2, 1
PRINT "Отредактируйте его вновь."
DO: LOOP WHILE INKEY$ = ""
CLOSE
GOTO 12345
END IF
LOOP
CLOSE


OPEN "i", #1, "redaktor"
OPEN "a", #2, "ptb\party_" + file$ + ".ptb"
DO WHILE NOT EOF(1)
LINE INPUT #1, vop$
IF INSTR(vop$, "(*") <= 0 THEN PRINT #2, vop$
LOOP

CLOSE

KILL "redaktor"
'KILL "redaktor.bak"

OPEN "a", #1, "ptb\party_" + file$ + ".ptb"
PRINT #1, " ~"
CLOSE

SCREEN 0
GOTO 6

'HELP
CASE IS = 14
SCREEN 0
SHELL "wd\wd help.me"
SCREEN 0
GOTO 6

CASE IS = 15
SCREEN 0
COLOR 15, 0
CLS
END

END SELECT

END SUB

SUB oshibki

SCREEN 0
CALL ramka(X, Y, X1, Y1, COLOUR, SHRIFT)
LOCATE 19, 1
PRINT "╠" + STRING$(78, "═") + "╣";
COLOR 7, 1
niz$ = "Правильный вариант ответа выделен зеленым цветом."
CALL seredina(niz$, 80, space%)
LOCATE 21, space%
PRINT niz$
niz$ = "Для просмотра источника нажмите 'F1'."
CALL seredina(niz$, 80, space%)
LOCATE 22, space%
PRINT niz$
niz$ = "Далее 'пробел' или 'ENTER'"
CALL seredina(niz$, 80, space%)
LOCATE 23, space%
PRINT niz$

FOR df = 1 TO nn - 1
file$ = MID$(otvets$(df), 2, 1)
IF file$ = "1" THEN
IF MID$(otvets$(df), 2, 2) = "10" THEN file$ = "10"
END IF

CALL textwindow(2, 18, 0, 15)

OPEN "i", #1, "ptb\party_" + file$ + ".ptb"
k = 0
m = 1
DO WHILE NOT EOF(1)
LINE INPUT #1, text$
first% = INSTR(text$, otvets$(df))
konec% = INSTR(text$, " ~")
IF first% > 0 THEN
k = 1
m = 1
pravotv% = VAL(RIGHT$(RTRIM$(text$), 1))
END IF
IF m > 19 THEN m = 19
LOCATE m, 4
IF konec% > 0 AND k = 1 THEN EXIT DO
IF k = 1 AND first <= 0 THEN
IF INSTR(text$, CHR$(159 + pravotv) + ")") > 0 THEN COLOR 10, 0
IF INSTR(text$, CHR$(160 + pravotv) + ")") > 0 THEN COLOR 15, 0
PRINT text$
END IF
m = m + 1

LOOP
234 :
k = 0
CALL kodkey(kod)
SELECT CASE kod
CASE IS = 59
COLOR 7, 9
LOCATE 21, 2: PRINT SPACE$(78)
LOCATE 22, 2: PRINT SPACE$(78)
LOCATE 23, 2: PRINT SPACE$(78)
niz$ = "Нажмите любую клавишу"
CALL seredina(niz$, 80, space%)
LOCATE 22, space%
PRINT niz$
CALL textwindow(2, 18, 0, 15)
DO WHILE NOT EOF(1)
LINE INPUT #1, text$
first% = INSTR(text$, " !")
konec% = INSTR(text$, " ~")
IF first% > 0 THEN
k = 1
m = 2
END IF
IF m > 19 THEN m = 19
LOCATE m, 4
IF konec% > 0 AND k = 1 THEN EXIT DO
IF k = 1 AND first <= 0 THEN
PRINT text$
END IF
m = m + 1
LOOP
df = df - 1
DO: LOOP WHILE INKEY$ = ""
COLOR 7, 9
niz$ = "Правильный вариант ответа выделен зеленым цветом."
CALL seredina(niz$, 80, space%)
LOCATE 21, space%
PRINT niz$
niz$ = "Для просмотра источника нажмите 'F1'."
CALL seredina(niz$, 80, space%)
LOCATE 22, space%
PRINT niz$
niz$ = "Далее 'пробел' или 'ENTER'"
CALL seredina(niz$, 80, space%)
LOCATE 23, space%
PRINT niz$
CASE IS = 32
SOUND 500, .5
CASE IS = 13
SOUND 500, .5
CASE ELSE
GOTO 234
END SELECT

CLOSE
NEXT

END SUB

SUB pole (coordx, coordy, coordx1, coordy1, cvet1, cvet2)

REM ПРОЦЕДУРА РИСУЕТ ПОЛЕ С ТЕНЬЮ
PALETTE 15, 65536 * 55 + 256 * 55 + 55
COLOR cvet1
LOCATE coordx, coordy: PRINT "┌" + STRING$(coordy1 - coordy - 1, "─");
FOR n = coordx + 1 TO coordx1 - 1
LOCATE n, coordy: PRINT "│";
NEXT
LOCATE coordx1, coordy: PRINT "└";
COLOR cvet2
LOCATE coordx, coordy1: PRINT "┐";
FOR n = coordx + 1 TO coordx1 - 1
LOCATE n, coordy1: PRINT "│";
NEXT
LOCATE coordx1, coordy + 1: PRINT STRING$(coordy1 - coordy - 1, "─") + "┘";
PALETTE 7, 65536 * 10 + 256 * 10 + 10

END SUB

SUB polename (txt1$, txt2$, txt3$, txt4$, niz$)


REM ОЧИЩАЕМ ЭКРАН И БУФЕР КЛАВИАТУРЫ, ПЛАВНО ИЗМЕНЯЕМ ФОН
CLS
DO WHILE INKEY$ <> "": LOOP
FOR Z = 0 TO 35
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
REM РИСУЕМ ПОЛЯ ДЛЯ ВВОДА ДАННЫХ
CALL pole(6, 4, 25, 76, 15, 7)
COLOR 11
CALL seredina(niz$, 80, space1%)
LOCATE 7, space1%
PRINT niz$
LOCATE 10, 7
PRINT txt1$
LOCATE 14, 7
PRINT txt2$
LOCATE 18, 7
PRINT txt3$
LOCATE 22, 7
PRINT txt4$
n = LEN(txt1$)
IF LEN(txt2$) > n THEN n = LEN(txt2$)
IF LEN(txt3$) > n THEN n = LEN(txt3$)
IF LEN(txt4$) > n THEN n = LEN(txt4$)
CALL pole(9, n + 8, 11, 80 - 8, 7, 15)
CALL pole(13, n + 8, 15, 80 - 8, 7, 15)
CALL pole(17, n + 8, 19, 80 - 8, 7, 15)
CALL pole(21, n + 8, 23, 80 - 8, 7, 15)

REM ВВОД ДАННЫХ В ПОЛЯ
txt1$ = ""
CALL textpole(n + 10, 10, 17, txt1$)
txt2$ = ""
CALL textpole(n + 10, 14, 17, txt2$)
txt3$ = ""
CALL textpole(n + 10, 18, 17, txt3$)
txt4$ = ""
CALL textpole(n + 10, 22, 17, txt4$)
REM ОЧИЩАЕМ И ГАСИМ ЭКРАН
CLS
FOR Z = 35 TO 0 STEP -1
PALETTE 0, 65536 * Z + 256 * Z + Z
NEXT
CLOSE #1

END SUB

SUB press (j)

COLOR 0, 3
LOCATE 22, j + 2
PRINT " "
Z = 6
d = 3
s = 0
CALL knopka(j, Z, d, s)
COLOR 0, 3
LOCATE 23, j + 3
PRINT SPACE$(9)
zader = 2
CALL vremia(zader)
END SUB

SUB ramka (X, Y, X1, Y1, COLOUR, SHRIFT)

CLS
COLOR SHRIFT, COLOUR
        LOCATE X, Y: PRINT "╔" + STRING$(Y1 - Y - 1, "═") + "╗";
FOR i = X + 1 TO X1 - 1
        LOCATE i, Y: PRINT "║" + SPACE$(Y1 - Y - 1) + "║";
NEXT i
        LOCATE X1, Y: PRINT "╚" + STRING$(Y1 - Y - 1, "═") + "╝";

END SUB

SUB sel

DO
CALL kodkey(kod)
SELECT CASE kod
CASE 27
PALETTE 5, 63
COLOR 5
PRINT "Нет"
PRINT #1, " 0";
EXIT DO
CASE 13
COLOR 10
PRINT "Да"
PRINT #1, " 1";
EXIT DO
END SELECT
LOOP

END SUB

SUB seredina (lines$, dlina%, space1%)

REM процедура для вывода строки по середине
plus = 0: space1 = 0
lines$ = RTRIM$(LTRIM$(lines$))
real = LEN(lines$)
dobavka = dlina - real
IF dobavka < 0 THEN EXIT SUB
IF dobavka MOD 2 <> 0 THEN plus = 1
space1 = dobavka \ 2 + plus

END SUB

SUB sravnenie

IF pravotv = variant THEN
crit! = crit! + .5
ELSE
LOCATE 25, 13
otvets$(nn) = number$
nn = nn + 1
END IF

END SUB

SUB strelki (arr%, t%, x2%, x3%, maxi%, mini%)

FOR n = x2 + 1 TO x3 - 1
IF arr <> 18 THEN
IF vibor(arr - 6) = 0 THEN ghj = 7 ELSE ghj = 6
ELSE EXIT SUB
END IF
CALL ten(arr, n, ghj)
NEXT

arr = arr + t
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT

IF arr > maxi THEN
arr = mini
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr + t, n, 7)
NEXT
COLOR 15, 1
LOCATE maxi, x2
PRINT CHR$(32)
LOCATE maxi, x3
PRINT CHR$(32)
END IF

IF arr < mini THEN
arr = maxi
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr, n, 15)
NEXT
FOR n = x2 + 1 TO x3 - 1
CALL ten(arr + t, n, 7)
NEXT
COLOR 15, 1
LOCATE mini, x3
PRINT CHR$(32)
LOCATE mini, x2
PRINT CHR$(32)
END IF

COLOR 15, 1
LOCATE arr, x2
PRINT CHR$(16)
COLOR 15, 1
LOCATE arr, x3
PRINT CHR$(17)
COLOR 15, 1
IF t = 0 THEN EXIT SUB
LOCATE arr - t, x2
PRINT CHR$(32)
COLOR 15, 1
LOCATE arr - t, x3
PRINT CHR$(32)

END SUB

SUB struktura

CLS
col = 9
CALL ramka(X, Y, X1, Y1, col, 0)
stroka = 24: col = 9
CALL textwindow(2, 24, 9, 15)
LOCATE 3, 5
PRINT "1  -  Организационные мероприятия обеспечивающие безопасность работ"
LOCATE , 5
PRINT "2  -  Технические мероприятия обеспечивающие безопасность работ "
LOCATE , 5
PRINT "3  -  Первая медицинская помощь"
LOCATE , 5
PRINT "4  -  Техническое обслуживание и ремонт оборудования,"
LOCATE , 5
PRINT "      вопросы теории электротехники"
LOCATE , 5
PRINT "5  -  Инструкции по оперативному обслуживанию ПС и ППС"
LOCATE , 5
PRINT "6  -  Содержание защитных средств"
LOCATE , 5
PRINT "7  -  Испытание защитных средств"
LOCATE , 5
PRINT "8  -  ПУЭ"
LOCATE , 5
PRINT "9  -  ПТЭ железных дорог"
LOCATE , 5
PRINT "10 -  Общие вопросы организации электрохозяйства"

END SUB

SUB ten (arr%, n%, col%)

kodchar = ASC(CHR$(SCREEN(arr, n)))
LOCATE arr, n
COLOR col, 1
PRINT CHR$(kodchar)

END SUB

SUB textpole (b, c, kol, streng$)

REM ПРОЦЕДУРА ДЛЯ ВВОДА ДАННЫХ (ИЗ-ЗА РУСКОЙ БУКВЫ "р")
4 :
streng$ = ""
new = b
DO
IF b < new THEN b = new
LOCATE c, b
PRINT "█"
CALL char(a$)
IF a$ = CHR$(13) THEN
LOCATE c, b
PRINT " "
EXIT DO
END IF
IF LEN(a$) <> 1 OR a$ = CHR$(27) OR a$ = CHR$(9) THEN GOTO 5
IF a$ = CHR$(8) THEN
LOCATE c, b
PRINT " "
b = b - 1
txt$(b - new + 1) = " "
GOTO 5
END IF
LOCATE c, b
PRINT a$;
txt$(b - new + 1) = a$
IF b > new + kol - 2 THEN b = new + kol - 2
b = b + 1
5 :
LOOP
FOR l = 1 TO b - new + 1
streng$ = streng$ + txt$(l)
NEXT
ERASE txt$
IF streng$ = "" THEN GOTO 4

END SUB

SUB textwindow (stroka0%, stroka%, col%, SHRIFT%)


        COLOR SHRIFT, col
        FOR i = stroka0 TO stroka
                LOCATE i, 2
                PRINT SPACE$(78);
        NEXT i

END SUB

SUB vopros (count)
ncount = count
'CALL textwindow(2, 18, 0, 15)
CALL botton

LOCATE 1, 20: PRINT "│ Поиск вопроса, подождите ...  │"
45 :
CALL textwindow(2, 18, 0, 15)
n = 1

REM Определение номера вопроса
file$ = LTRIM$(STR$(ncount%))
OPEN "i", #1, "include\config.dat"
FOR i = 1 TO ncount
INPUT #1, min
INPUT #1, max
NEXT
CLOSE
nomer% = INT(max - (max * RND)) + 1
number$ = " " + file$ + "." + LTRIM$(STR$(nomer%))

REM Защита от повтора номера
DO
IF nomera$(n) = number$ THEN
nomer% = INT((max - min + 1) - (max * RND)) + min
number$ = " " + file$ + "." + LTRIM$(STR$(nomer%))
n = 0
END IF
n = n + 1
LOOP WHILE n < count
nomera$(count) = number$

REM Ввод вопроса из файла и вывод текста на экран
OPEN "i", #1, "ptb\party_" + file$ + ".ptb"
k = 0
m = 2
'''''''''''''''''''''
'LOCATE 1, 1: PRINT " Часть:"; file$
tmpline1 = 0
DO WHILE NOT EOF(1)
tmpline1 = tmpline1 + 1
LINE INPUT #1, text$
first% = INSTR(text$, number$)
konec% = INSTR(text$, " ~")
IF first% > 0 THEN
k = 1
m = 1
pravotv% = VAL(RIGHT$(RTRIM$(text$), 1))

vhod = INSTR(text$, rab$)
prov = VAL(MID$(text$, vhod + (arr - 5) * 3, 2))

IF prov <> 1 THEN
REM Рисуем экран

CALL textwindow(2, 18, 0, 15)
CALL botton

ncount = prov
IF prov < 0 THEN ncount = ABS(prov)
IF prov = 0 THEN ncount = count
IF MID$(text$, vhod + (arr - 5) * 3, 2) = "-0" THEN ncount = 10
CLOSE
GOTO 45
END IF
END IF

IF m > 19 THEN m = 19
LOCATE m, 4
IF konec% > 0 AND k = 1 THEN EXIT DO
IF k = 1 AND first <= 0 THEN PRINT text$
m = m + 1

LOOP
CLOSE #1
'LOCATE 1, 20: PRINT "│                               │"
 LOCATE 1, 20: PRINT "│ Вопрос из раздела N: "; file$; "       "
END SUB

SUB vremia (zader)

DEF SEG = 0
start = PEEK(&H46C)
finish = start + zader
IF finish > 255 THEN finish = finish - 255
DO: LOOP WHILE PEEK(&H46C) <> finish
DEF SEG

END SUB

SUB vvodvopr (b, c, kol, streng$)

REM ПРОЦЕДУРА ДЛЯ ВВОДА ДАННЫХ (ИЗ-ЗА РУСКОЙ БУКВЫ "р")
12 :
streng$ = ""
new = b
cc = 0
DO
IF b < new THEN b = new
LOCATE c, b
PRINT "█"
CALL char(a$)
IF a$ = CHR$(9) THEN GOTO 14
IF a$ = CHR$(13) THEN
LOCATE c, b
PRINT " "
EXIT DO
END IF
IF LEN(a$) <> 1 THEN
kod = ASC(RIGHT$(a$, 1))
IF kod = 68 THEN
FOR l = 1 TO b - new + 1
streng$ = streng$ + txt$(l)
NEXT
streng$ = streng$ + "end"
ERASE txt$
EXIT SUB
END IF
END IF
IF LEN(a$) <> 1 OR a$ = CHR$(27) THEN GOTO 14
IF a$ = CHR$(8) THEN
LOCATE c, b
PRINT " "
b = b - 1
GOTO 14
END IF
LOCATE c, b
PRINT a$;
txt$(b - new + 1) = a$
IF b > new + kol - 2 THEN
EXIT DO
END IF
b = b + 1
14 :
LOOP

FOR l = 1 TO b - new + 1
streng$ = streng$ + txt$(l)
NEXT
ERASE txt$

END SUB

SUB zastavka

REM ОЧИЩАЕМ ЭКРАН, ПЛАВНО ИЗМЕНЯЕМ ЦВЕТ ФОНА
REM И УСТАНАВЛИВАЕМ ОСНОВНОЙ ЦВЕТ
COLOR 1, 1
CLS
'FOR Z = 0 TO 50
    'PALETTE 0, 65536 * Z
'NEXT
COLOR 10

REM ВЫВОДИМ ТЕКСТ
niz$ = "ОБУЧАЮЩЕ-ЭКЗАМЕНАЦИОННЫЙ КОМПЛЕКС ДЛЯ ДИСТАНЦИЙ ЭЛЕКТРОСНАБЖЕНИЯ"
CALL seredina(niz$, 80, space1%)
LOCATE 8, space1%
PRINT niz$
niz$ = "Программа предназначена для работников района электроснабжения"
CALL seredina(niz$, 80, space1%)
LOCATE 13, space1%
PRINT niz$
niz$ = "Версия N 1.0"
CALL seredina(niz$, 80, space1%)
LOCATE 17, space1%
PRINT niz$
 niz$ = "Разработчик программы: Кафедра электроснабжения транспорта"
CALL seredina(niz$, 80, space1%)
LOCATE 21, space1%
PRINT niz$
niz$ = "УрГАПС"
CALL seredina(niz$, 80, space1%)
LOCATE 24, space1%
PRINT niz$
niz$ = "1997"
CALL seredina(niz$, 80, space1%)
LOCATE 25, space1%
PRINT niz$

REM ждем нажатие клавиши и плавно гасим экран
DO: LOOP WHILE INKEY$ = ""
CLS
'FOR Z = 50 TO 0 STEP -1
'PALETTE 0, 65536 * Z
'NEXT
SCREEN 0
COLOR 7, 0
CALL intter11
END SUB

