DECLARE SUB PrintXY (x%, y%, Phrase$, Cvt%)
DECLARE SUB PrintFillXY (x%, y%, Phrase$, Cvt1%, Cvt2%)
DECLARE SUB PrintFillXYCntr (xc%, y%, Phrase$, Cvt1%, Cvt2%)
DECLARE SUB PrepareALL ()
DECLARE SUB Spravka ()
DECLARE SUB Test ()
DIM SHARED Charset%(255, 15), PowTB%(8)
DIM SHARED Voprosi$(19), Varianty$(20, 3), Verno%(19)
DIM SHARED Name$
Vop: DATA "Как не сломать себе руку во время катания на лыжах?"
DATA 4
DATA "Ехать аккуратно"
DATA "Ехать настолько быстро, насколько возможно и сломать себе ВСЁ!"
DATA "Слушать препода"
DATA "Ознакомиться с инструкциями по безопасности"
DATA "****1****|****2****|****3****|****4****|****5****|****6****|****7****|****8****|****9****|****10***|****11***|****12***|****13***|****14***|****15***|****16***|****17***|****18***|****19***|"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №3?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №4?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №5?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №6?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №7?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №8?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №9?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №10?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №11?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №12?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №13?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №14?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №15?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №16?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №17?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №18?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №19?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №20?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
SCREEN 12
PrepareALL ' Инициализируем программу и данные
Spravka ' Справка
Test ' Тест
END
' Дата дополнительной раскладки(коды 128-255)
DATA 0,0,0,24,60,102,102,102,126,102,102,102,102,0,0,0
DATA 0,0,0,127,70,70,6,62,102,102,102,102,63,0,0,0
DATA 0,0,0,63,102,102,102,62,102,102,102,102,63,0,0,0
DATA 0,0,0,254,140,140,12,12,12,12,12,12,30,0,0,0
DATA 0,0,0,120,108,102,102,102,102,102,102,102,255,195,129,0
DATA 0,0,0,127,102,70,22,30,22,6,70,102,127,0,0,0
DATA 0,0,0,107,107,42,42,62,62,42,107,107,107,0,0,0
DATA 0,0,0,62,99,96,96,60,96,96,96,99,62,0,0,0
DATA 0,0,0,99,99,99,115,123,111,103,99,99,99,0,0,0
DATA 0,0,48,88,107,99,115,123,111,103,99,99,99,0,0,0
DATA 0,0,0,103,102,54,54,30,30,54,54,102,103,0,0,0
DATA 0,0,0,120,108,102,99,99,99,99,99,99,99,0,0,0
DATA 0,0,0,99,119,127,127,107,99,99,99,99,99,0,0,0
DATA 0,0,0,99,99,99,99,127,99,99,99,99,99,0,0,0
DATA 0,0,0,62,99,99,99,99,99,99,99,99,62,0,0,0
DATA 0,0,0,127,99,99,99,99,99,99,99,99,99,0,0,0
DATA 0,0,0,63,102,102,102,62,6,6,6,6,15,0,0,0
DATA 0,0,0,60,102,67,3,3,3,3,67,102,60,0,0,0
DATA 0,0,0,126,90,24,24,24,24,24,24,24,60,0,0,0
DATA 0,0,0,102,102,102,102,102,124,96,96,102,60,0,0,0
DATA 0,0,0,60,24,126,219,219,219,219,219,126,24,60,0,0
DATA 0,0,0,102,102,102,60,24,60,102,102,102,102,0,0,0
DATA 0,0,0,102,102,102,102,102,102,102,102,102,254,192,0,0
DATA 0,0,0,99,99,99,99,99,126,96,96,96,96,0,0,0
DATA 0,0,0,219,219,219,219,219,219,219,219,219,255,0,0,0
DATA 0,0,0,219,219,219,219,219,219,219,219,219,255,192,192,0
DATA 0,0,0,31,13,12,12,124,204,204,204,204,126,0,0,0
DATA 0,0,0,195,195,195,195,207,219,219,219,219,207,0,0,0
DATA 0,0,0,15,6,6,6,62,102,102,102,102,63,0,0,0
DATA 0,0,0,60,102,96,96,120,96,96,102,102,60,0,0,0
DATA 0,0,0,115,219,219,219,223,219,219,219,219,115,0,0,0
DATA 0,0,0,252,102,102,102,124,124,102,102,102,231,0,0,0
DATA 0,0,0,0,0,0,30,48,62,51,51,51,110,0,0,0
DATA 0,0,0,0,32,48,30,3,31,51,51,51,30,0,0,0
DATA 0,0,0,0,0,0,63,102,102,62,102,102,63,0,0,0
DATA 0,0,0,0,0,0,127,70,6,6,6,6,15,0,0,0
DATA 0,0,0,0,0,0,120,108,108,102,102,102,255,195,195,0
DATA 0,0,0,0,0,0,62,99,127,3,3,99,62,0,0,0
DATA 0,0,0,0,0,0,107,107,42,62,42,107,107,0,0,0
DATA 0,0,0,0,0,0,60,98,48,120,96,98,60,0,0,0
DATA 0,0,0,0,0,0,99,99,115,107,103,99,99,0,0,0
DATA 0,0,0,16,24,8,99,99,115,107,103,99,99,0,0,0
DATA 0,0,0,0,0,0,103,54,30,30,54,102,103,0,0,0
DATA 0,0,0,0,0,0,112,120,108,108,108,108,102,0,0,0
DATA 0,0,0,0,0,0,65,99,119,107,107,99,99,0,0,0
DATA 0,0,0,0,0,0,99,99,99,127,99,99,99,0,0,0
DATA 0,0,0,0,0,0,62,99,99,99,99,99,62,0,0,0
DATA 0,0,0,0,0,0,127,99,99,99,99,99,99,0,0,0
DATA 68,17,68,17,68,17,68,17,68,17,68,17,68,17,68,17
DATA 170,85,170,85,170,85,170,85,170,85,170,85,170,85,170,85
DATA 187,238,187,238,187,238,187,238,187,238,187,238,187,238,187,238
DATA 24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,31,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,31,24,31,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,108,108,111,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,0,0,127,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,31,24,31,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,111,96,111,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,108,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,127,96,111,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,111,96,127,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,108,108,127,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,31,24,31,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,31,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,248,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,24,24,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,248,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,255,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,24,24,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,248,24,248,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,108,108,236,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,236,12,252,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,252,12,236,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,239,0,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,255,0,239,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,236,12,236,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,255,0,255,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,239,0,239,108,108,108,108,108,108,108,108
DATA 24,24,24,24,24,255,0,255,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,108,108,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,255,0,255,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,255,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,252,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,248,24,248,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,248,24,248,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,252,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,255,108,108,108,108,108,108,108,108
DATA 24,24,24,24,24,255,24,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,31,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,248,24,24,24,24,24,24,24,24
DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
DATA 0,0,0,0,0,0,0,255,255,255,255,255,255,255,255,255
DATA 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15
DATA 240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,240
DATA 255,255,255,255,255,255,255,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,59,102,102,102,102,102,62,6,6,15
DATA 0,0,0,0,0,0,62,99,3,3,3,99,62,0,0,0
DATA 0,0,0,0,0,0,126,90,24,24,24,24,60,0,0,0
DATA 0,0,0,0,0,0,102,102,102,102,124,96,48,28,0,0
DATA 0,0,0,0,0,60,24,126,219,219,219,219,126,24,24,60
DATA 0,0,0,0,0,0,99,54,28,28,28,54,99,0,0,0
DATA 0,0,0,0,0,0,102,102,102,102,102,254,192,0,0,0
DATA 0,0,0,0,0,0,102,102,102,126,124,96,96,0,0,0
DATA 0,0,0,0,0,0,107,107,107,107,107,107,127,0,0,0
DATA 0,0,0,0,0,0,107,107,107,107,107,107,127,192,192,0
DATA 0,0,0,0,0,0,31,13,12,124,204,204,126,0,0,0
DATA 0,0,0,0,0,0,99,99,99,111,123,123,111,0,0,0
DATA 0,0,0,0,0,0,15,6,6,62,102,102,63,0,0,0
DATA 0,0,0,0,0,0,60,102,96,120,96,102,60,0,0,0
DATA 0,0,0,0,0,0,115,219,219,223,219,219,115,0,0,0
DATA 0,0,0,0,0,0,124,102,102,102,124,104,102,0,0,0
DATA 0,0,108,0,254,140,12,44,60,44,12,140,254,0,0,0
DATA 0,0,0,0,0,102,0,60,102,126,6,102,60,0,0,0
DATA 0,0,0,0,12,24,48,96,48,24,12,0,126,0,0,0
DATA 0,0,0,0,48,24,12,6,12,24,48,0,126,0,0,0
DATA 0,0,0,112,216,216,24,24,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,24,24,27,27,27,14,0,0,0
DATA 0,0,0,0,0,24,24,0,126,0,24,24,0,0,0,0
DATA 0,0,0,0,0,0,110,59,0,110,59,0,0,0,0,0
DATA 0,28,54,54,28,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,24,24,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,24,0,0,0,0,0,0,0
DATA 0,0,240,48,48,48,48,48,55,54,54,60,56,0,0,0
DATA 0,0,0,0,51,243,243,247,63,251,51,51,51,0,0,0
DATA 0,28,54,24,12,38,62,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,62,62,62,62,62,62,62,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
SUB PrepareALL
OUT &H3C8, 1: OUT &H3C9, 8: OUT &H3C9, 8: OUT &H3C9, 8
OUT &H3C8, 2: OUT &H3C9, 13: OUT &H3C9, 13: OUT &H3C9, 13
OUT &H3C8, 3: OUT &H3C9, 18: OUT &H3C9, 18: OUT &H3C9, 18
OUT &H3C8, 9: OUT &H3C9, 0: OUT &H3C9, 32: OUT &H3C9, 63
' Читаем ВОПРОСЫ и ВАРИАНТЫ
FOR i% = 0 TO 19
READ Voprosi$(i%) ' Читаем строку вопрос
READ Verno%(i%) ' Номер верного варианта ответа
FOR v% = 0 TO 3 ' Цикл на 4 повторения
READ Varianty$(i%, v%) ' Читаем строку каждого варианта
NEXT
NEXT
' Таблица степеней двойки
FOR i% = 0 TO 8: PowTB%(i%) = 2 ^ i%: NEXT
' Загрузка расширенной раскладки из DATA
FOR i% = 0 TO 127: FOR s% = 0 TO 15
READ Charset%(i% + 128, s%)
NEXT s%, i%
' Загрузка обычной раскладки из системного шрифта
FOR i% = 0 TO 127
LOCATE 1, 1: PRINT CHR$(i%)
FOR s% = 0 TO 15
SU% = 0
FOR x% = 0 TO 8
IF POINT(x%, s%) <> 0 THEN SU% = SU% + PowTB%(x%)
NEXT
Charset%(i%, s%) = SU%
NEXT
NEXT
END SUB
SUB PrintFillXY (x%, y%, Phrase$, Cvt1%, Cvt2%)
Cvt1% = -(Cvt1% - Cvt2%)
DL% = LEN(Phrase$) - 1
FOR s% = 0 TO DL%
xpls% = s% * 9: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iy% = 0 TO 15
FOR ix% = 0 TO 8
Cv% = Cvt2% + ((Charset%(Lit%, iy%) AND PowTB%(ix%)) > 0) * Cvt1%
PSET (ix% + x% + xpls%, iy% + y%), Cv%
NEXT
NEXT
NEXT
END SUB
SUB PrintFillXYCntr (xc%, y%, Phrase$, Cvt1%, Cvt2%)
Cvt1% = -(Cvt1% - Cvt2%)
DL% = LEN(Phrase$) - 1
xmin% = (DL% * 9) \ 2
FOR s% = 0 TO DL%
xpls% = s% * 9 - xmin%: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iy% = 0 TO 15
FOR ix% = 0 TO 8
Cv% = Cvt2% + ((Charset%(Lit%, iy%) AND PowTB%(ix%)) > 0) * Cvt1%
PSET (ix% + xc% + xpls%, iy% + y%), Cv%
NEXT
NEXT
NEXT
END SUB
SUB PrintXY (x%, y%, Phrase$, Cvt%)
DL% = LEN(Phrase$) - 1
FOR s% = 0 TO DL%
xpls% = s% * 9: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iy% = 0 TO 15
FOR ix% = 0 TO 8
IF (Charset%(Lit%, iy%) AND PowTB%(ix%)) > 0 THEN
PSET (ix% + x% + xpls%, iy% + y%), Cvt%
END IF
NEXT
NEXT
NEXT
END SUB
SUB Spravka
CLS
LINE (3, 3)-(637, 460), 3, B
'COLOR 2
'LOCATE 5, 35
'PRINT "<СПРАВКА>"
PrintXY 285, 60, "<СПРАВКА>", 10
PrintXY 30, 110, "Данная программа представляет собой тест по теме <ОБЖ>, состоящий", 6
PrintXY 30, 126, "из 20 вопросов. На каждый вопрос предлагается 3 варианта ответа.", 6
PrintXY 30, 142, "Выбор ответа осуществляется с помощью нажатия клавиш вверх, вниз.", 6
PrintXY 30, 158, "Подтверждение выбранного пункта клавишей Enter", 6
PrintXY 30, 174, "Для начала тестирования необходимо нажать любую клавишу.", 6
PrintXY 30, 190, "Результаты будут отображены сразу после прохождения теста.", 6
PrintXY 380, 272, "Автор теста: Смирнов Дмитрий", 9
PrintXY 380, 288, "ученик 44 школы", 9
PrintXY 290, 400, "2011 год", 3
COLOR 8
LOCATE 27, 18
Sost% = 0
WHILE INKEY$ = ""
IF Sost% <> (INT((TIMER - INT(TIMER)) * 10) AND 2) THEN
Sost% = (INT((TIMER - INT(TIMER)) * 10) AND 2) \ 2
PrintXY 120, 432, "Для начала тестирования нажмите любую клавишу", 2 + Sost%
END IF
WEND
END SUB
SUB Test
LINE (0, 0)-(639, 479), 1, BF
FOR i% = 0 TO 640 STEP 6
FOR j% = 0 TO 2
LINE (i% + j%, 0)-(i% + j% + 50, 50), 2
LINE (i% + j% + 3, 0)-(i% + j% + 53, 50), 3
LINE (639 - i% - j%, 479)-(639 - i% - j% - 50, 429), 3
LINE (639 - i% - j% - 3, 479)-(639 - i% - j% - 53, 429), 2
NEXT
NEXT
LINE (0, 0)-(639, 479), 7, B ' Серая рамка программы
LINE (30, 290)-(610, 425), 0, BF ' Чёрная облсть под текстом
PrintXY 200, 200, "Введите ваше имя:", 11
PrintXY 100, 293, "Если вы запускаете программу из под ОС WINDOWS то", 7
PrintXY 40, 309, "русская раскладка включается через правый CTRL+SHIFT", 10
PrintXY 40, 325, "английская раскладка включается через левый CTRL+SHIFT", 10
PrintXY 100, 341, "Если вы запускаете программу из под ОС MS-DOS", 7
PrintXY 100, 357, "и используете резидентные драйверы, то вариантов", 7
PrintXY 100, 373, "переключения раскладки может быть несколько:", 7
PrintXY 40, 389, "Правый SHIFT\левый SHIFT, оба SHIFT'а, оба CTRL", 10
PrintXY 40, 405, "Правый ALT+SHIFT, правый CTRL\левый CTRL", 10
' Ввод имени перед тестом
Rdr% = 1
DO: Kb$ = INKEY$
' Удаление символа
IF Kb$ = CHR$(8) AND LEN(Name$) > 0 THEN
Name$ = LEFT$(Name$, LEN(Name$) - 1): Rdr% = 1
END IF
' Добавка символа
IF (Kb$ > "@" AND Kb$ < "[") OR (Kb$ > "`" AND Kb$ < "{") THEN
IF LEN(Name$) < 15 THEN
Name$ = Name$ + Kb$: Rdr% = 1
END IF
ELSEIF (Kb$ > "" AND Kb$ < "░") OR (Kb$ > "▀" AND Kb$ < "Є") THEN
IF LEN(Name$) < 15 THEN
Name$ = Name$ + Kb$: Rdr% = 1
END IF
END IF
IF Rdr% = 1 THEN PrintFillXYCntr 320, 220, " " + Name$ + "_ ", 15, 1
Rdr% = 0
LOOP UNTIL Kb$ = CHR$(13)
LINE (1, 51)-(638, 425), 1, BF ' Очищаем область
' Сам тест
VoprNum% = 0 ' Начнём с первого вопроса
Vo% = 1 ' Вариант ответа
Score% = 0 ' Сколько юзер ответил
Izm% = 1 ' Отобразить выбор
' Печатаем первый вопрос перед циклом
PrintFillXYCntr 320, 55, "ВОПРОС №" + STR$(VoprNum% + 1), 15, 1
PrintXY 50, 100, "Внимание вопрос:", 10
' Раскладываем вопрос по строкам
Tx1$ = LEFT$(Voprosi$(VoprNum%), 65)
IF LEN(Voprosi$(VoprNum%)) > 65 THEN
Tx2$ = MID$(Voprosi$(VoprNum%), 66, 65)
END IF
IF LEN(Voprosi$(VoprNum%)) > 130 THEN
Tx3$ = MID$(Voprosi$(VoprNum%), 131, 65)
END IF
' Печатаем вопрос
PrintXY 20, 150, Tx1$, 7
PrintXY 20, 166, Tx2$, 7
PrintXY 20, 182, Tx3$, 7
' Печатаем варианты
PrintXY 100, 250, "1] " + LEFT$(Varianty$(VoprNum%, 0), 50), 9
PrintXY 127, 266, MID$(Varianty$(VoprNum%, 0), 51), 9
PrintXY 100, 290, "2] " + LEFT$(Varianty$(VoprNum%, 1), 50), 9
PrintXY 127, 306, MID$(Varianty$(VoprNum%, 1), 51), 9
PrintXY 100, 330, "3] " + LEFT$(Varianty$(VoprNum%, 2), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 2), 51), 9
PrintXY 100, 370, "4] " + LEFT$(Varianty$(VoprNum%, 3), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 3), 51), 9
' Цикл выбора варианта
DO: Kb$ = INKEY$
IF Kb$ = CHR$(0) + "H" AND Vo% > 0 THEN Vo% = Vo% - 1: Izm% = 1
IF Kb$ = CHR$(0) + "P" AND Vo% < 3 THEN Vo% = Vo% + 1: Izm% = 1
' Отрисовка окантовки выбора
IF Izm% = 1 THEN
Izm% = 0
FOR St% = 0 TO 3
Dln% = LEN(Varianty$(VoprNum%, St%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, St% * 40 + 245)-(130 + 9 * (1 + Dln%), St% * 40 + 270 + Vis%), 1, B
NEXT
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 10, B
END IF
IF Kb$ = CHR$(13) THEN
' Проверка верности выбора
IF Verno%(VoprNum%) = Vo% + 1 THEN
Score% = Score% + 1
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 10, BF
PrintXY 100, Vo% * 40 + 250 + Vis% \ 2, "Верно!", 0
ELSE
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 12, BF
PrintXY 100, Vo% * 40 + 250 + Vis% \ 2, "Неправильно!", 0
END IF
f! = TIMER: WHILE TIMER < f! + 1: Kb$ = INKEY$: WEND ' Ожидание
VoprNum% = VoprNum% + 1 ' Инкремент вопроса
IF VoprNum% = 20 THEN EXIT DO ' Выход если закончились вопр.
Izm% = 1 ' Для отрисовки выбора
LINE (1, 51)-(638, 425), 1, BF ' Очищаем область
' Раскладываем вопрос по строкам
Tx1$ = LEFT$(Voprosi$(VoprNum%), 65): Tx2$ = "": Tx3$ = ""
IF LEN(Voprosi$(VoprNum%)) > 65 THEN
Tx2$ = MID$(Voprosi$(VoprNum%), 66, 65)
END IF
IF LEN(Voprosi$(VoprNum%)) > 130 THEN
Tx3$ = MID$(Voprosi$(VoprNum%), 131, 65)
END IF
' Заголовок вопроса
PrintFillXYCntr 320, 55, "ВОПРОС №" + STR$(VoprNum% + 1), 15, 1
PrintXY 50, 100, "Внимание вопрос:", 10
' Печатаем вопрос
PrintXY 20, 150, Tx1$, 9
PrintXY 20, 166, Tx2$, 9
PrintXY 20, 182, Tx3$, 9
' Печатаем варианты
PrintXY 100, 250, "1] " + LEFT$(Varianty$(VoprNum%, 0), 50), 9
PrintXY 127, 266, MID$(Varianty$(VoprNum%, 0), 51), 9
PrintXY 100, 290, "2] " + LEFT$(Varianty$(VoprNum%, 1), 50), 9
PrintXY 127, 306, MID$(Varianty$(VoprNum%, 1), 51), 9
PrintXY 100, 330, "3] " + LEFT$(Varianty$(VoprNum%, 2), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 2), 51), 9
PrintXY 100, 370, "4] " + LEFT$(Varianty$(VoprNum%, 3), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 3), 51), 9
END IF
LOOP UNTIL Kb$ = CHR$(27)
' Результаты теста
IF VoprNum% = 20 THEN
LINE (1, 51)-(638, 425), 1, BF ' Очищаем область
LINE (50, 90)-(590, 200), 0, BF ' Очищаем область чёрным
LINE (50, 90)-(590, 200), 15, B ' Обводим белой рамкой
PrintFillXYCntr 320, 60, "Тест пройден успешно!", 10, 1
PrintFillXY 60, 100, "Уважаемый(ая) " + Name$ + " вы набрали", 7, 0
PrintFillXY 150, 120, STR$(Score%) + " правильных ответов", 10, 0
PrintFillXY 60, 140, "по классификации данного теста вам соответствует оценка:", 7, 0
' Вычисление оценки
SELECT CASE Score%
CASE 0 TO 10: Ball$ = " 2"
CASE 11 TO 13: Ball$ = " 3"
CASE 14 TO 17: Ball$ = " 4"
CASE 18 TO 20: Ball$ = " 5"
CASE ELSE
END SELECT
PrintFillXY 150, 160, Ball$, 10, 0
ELSE
LINE (1, 51)-(638, 425), 1, BF ' Очищаем область
PrintFillXYCntr 320, 230, "ТЕСТ ПРЕРВАН!", 12, 1
END IF
END SUB
' Структуры данных для *.BMP*
TYPE BMFile
BmID AS INTEGER
FileSize AS LONG
Reserved AS LONG
BmOFFSET AS LONG
END TYPE
TYPE BMHead
HeadSize AS LONG
BmpSizeX AS LONG
BmpSizeY AS LONG
BmSlices AS INTEGER
BitDepth AS INTEGER
Compress AS LONG
DataSize AS LONG
BmHorRes AS LONG
BmVerRes AS LONG
UseColor AS LONG
SingColr AS LONG
END TYPE
DECLARE SUB LoadBMP (x%, y%, FLName$, PALMode%)
DECLARE SUB FadePAL ()
DECLARE SUB PrintXY (x%, y%, Phrase$, Cvt%)
DECLARE SUB PrintFillXY (x%, y%, Phrase$, Cvt1%, Cvt2%)
DECLARE SUB PrintFillXYCntr (xc%, y%, Phrase$, Cvt1%, Cvt2%)
DECLARE SUB PrepareALL ()
DECLARE SUB Spravka ()
DECLARE SUB Zagolovok ()
DECLARE SUB Rezultat ()
DECLARE SUB Menu ()
DECLARE SUB Test ()
DIM SHARED FHead AS BMFile, BMPHead AS BMHead
DIM SHARED Re%(15), Gr%(15), Bl%(15)
DIM SHARED Charset%(255, 15), PowTB%(8)
DIM SHARED Voprosi$(19), Varianty$(20, 3), Verno%(19)
DIM SHARED MenuTx$(3), Vb%
DIM SHARED MyName$, Score%, VoprNum%
Vop: DATA "Как не сломать себе руку во время катания на лыжах?"
DATA 4
DATA "Ехать аккуратно"
DATA "Ехать настолько быстро, насколько возможно и сломать себе ВСЁ!"
DATA "Слушать препода"
DATA "Ознакомиться с инструкциями по безопасности"
DATA "****1****|****2****|****3****|****4****|****5****|****6****|****7****|****8****|****9****|****10***|****11***|****12***|****13***|****14***|****15***|****16***|****17***|****18***|****19***|"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №3?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №4?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №5?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №6?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №7?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №8?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №9?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №10?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №11?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №12?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №13?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №14?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №15?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №16?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №17?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №18?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №19?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
DATA "Вопрос №20?"
DATA 1
DATA "Вариант ответа №1"
DATA "Вариант ответа №2"
DATA "Вариант ответа №3"
DATA "Вариант ответа №4"
SCREEN 12
Zagolovok
PrepareALL ' Инициализируем программу и данные
DO
Menu
SELECT CASE Vb%
CASE 0: Spravka ' Справка
CASE 1: Test ' Тест
CASE 2: Rezultat ' Результат
CASE 3: EXIT DO ' Выход
CASE ELSE
END SELECT
LOOP
END
' Дата дополнительной раскладки(коды 128-255)
DATA 0,0,0,24,60,102,102,102,126,102,102,102,102,0,0,0
DATA 0,0,0,127,70,70,6,62,102,102,102,102,63,0,0,0
DATA 0,0,0,63,102,102,102,62,102,102,102,102,63,0,0,0
DATA 0,0,0,254,140,140,12,12,12,12,12,12,30,0,0,0
DATA 0,0,0,120,108,102,102,102,102,102,102,102,255,195,129,0
DATA 0,0,0,127,102,70,22,30,22,6,70,102,127,0,0,0
DATA 0,0,0,107,107,42,42,62,62,42,107,107,107,0,0,0
DATA 0,0,0,62,99,96,96,60,96,96,96,99,62,0,0,0
DATA 0,0,0,99,99,99,115,123,111,103,99,99,99,0,0,0
DATA 0,0,48,88,107,99,115,123,111,103,99,99,99,0,0,0
DATA 0,0,0,103,102,54,54,30,30,54,54,102,103,0,0,0
DATA 0,0,0,120,108,102,99,99,99,99,99,99,99,0,0,0
DATA 0,0,0,99,119,127,127,107,99,99,99,99,99,0,0,0
DATA 0,0,0,99,99,99,99,127,99,99,99,99,99,0,0,0
DATA 0,0,0,62,99,99,99,99,99,99,99,99,62,0,0,0
DATA 0,0,0,127,99,99,99,99,99,99,99,99,99,0,0,0
DATA 0,0,0,63,102,102,102,62,6,6,6,6,15,0,0,0
DATA 0,0,0,60,102,67,3,3,3,3,67,102,60,0,0,0
DATA 0,0,0,126,90,24,24,24,24,24,24,24,60,0,0,0
DATA 0,0,0,102,102,102,102,102,124,96,96,102,60,0,0,0
DATA 0,0,0,60,24,126,219,219,219,219,219,126,24,60,0,0
DATA 0,0,0,102,102,102,60,24,60,102,102,102,102,0,0,0
DATA 0,0,0,102,102,102,102,102,102,102,102,102,254,192,0,0
DATA 0,0,0,99,99,99,99,99,126,96,96,96,96,0,0,0
DATA 0,0,0,219,219,219,219,219,219,219,219,219,255,0,0,0
DATA 0,0,0,219,219,219,219,219,219,219,219,219,255,192,192,0
DATA 0,0,0,31,13,12,12,124,204,204,204,204,126,0,0,0
DATA 0,0,0,195,195,195,195,207,219,219,219,219,207,0,0,0
DATA 0,0,0,15,6,6,6,62,102,102,102,102,63,0,0,0
DATA 0,0,0,60,102,96,96,120,96,96,102,102,60,0,0,0
DATA 0,0,0,115,219,219,219,223,219,219,219,219,115,0,0,0
DATA 0,0,0,252,102,102,102,124,124,102,102,102,231,0,0,0
DATA 0,0,0,0,0,0,30,48,62,51,51,51,110,0,0,0
DATA 0,0,0,0,32,48,30,3,31,51,51,51,30,0,0,0
DATA 0,0,0,0,0,0,63,102,102,62,102,102,63,0,0,0
DATA 0,0,0,0,0,0,127,70,6,6,6,6,15,0,0,0
DATA 0,0,0,0,0,0,120,108,108,102,102,102,255,195,195,0
DATA 0,0,0,0,0,0,62,99,127,3,3,99,62,0,0,0
DATA 0,0,0,0,0,0,107,107,42,62,42,107,107,0,0,0
DATA 0,0,0,0,0,0,60,98,48,120,96,98,60,0,0,0
DATA 0,0,0,0,0,0,99,99,115,107,103,99,99,0,0,0
DATA 0,0,0,16,24,8,99,99,115,107,103,99,99,0,0,0
DATA 0,0,0,0,0,0,103,54,30,30,54,102,103,0,0,0
DATA 0,0,0,0,0,0,112,120,108,108,108,108,102,0,0,0
DATA 0,0,0,0,0,0,65,99,119,107,107,99,99,0,0,0
DATA 0,0,0,0,0,0,99,99,99,127,99,99,99,0,0,0
DATA 0,0,0,0,0,0,62,99,99,99,99,99,62,0,0,0
DATA 0,0,0,0,0,0,127,99,99,99,99,99,99,0,0,0
DATA 68,17,68,17,68,17,68,17,68,17,68,17,68,17,68,17
DATA 170,85,170,85,170,85,170,85,170,85,170,85,170,85,170,85
DATA 187,238,187,238,187,238,187,238,187,238,187,238,187,238,187,238
DATA 24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,31,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,31,24,31,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,108,108,111,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,0,0,127,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,31,24,31,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,111,96,111,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,108,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,127,96,111,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,111,96,127,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,108,108,127,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,31,24,31,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,31,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,248,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,24,24,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,248,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,255,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,24,24,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,248,24,248,24,24,24,24,24,24,24,24
DATA 108,108,108,108,108,108,108,236,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,236,12,252,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,252,12,236,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,239,0,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,255,0,239,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,236,12,236,108,108,108,108,108,108,108,108
DATA 0,0,0,0,0,255,0,255,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,239,0,239,108,108,108,108,108,108,108,108
DATA 24,24,24,24,24,255,0,255,0,0,0,0,0,0,0,0
DATA 108,108,108,108,108,108,108,255,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,255,0,255,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,255,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,252,0,0,0,0,0,0,0,0
DATA 24,24,24,24,24,248,24,248,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,248,24,248,24,24,24,24,24,24,24,24
DATA 0,0,0,0,0,0,0,252,108,108,108,108,108,108,108,108
DATA 108,108,108,108,108,108,108,255,108,108,108,108,108,108,108,108
DATA 24,24,24,24,24,255,24,255,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,31,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,248,24,24,24,24,24,24,24,24
DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
DATA 0,0,0,0,0,0,0,255,255,255,255,255,255,255,255,255
DATA 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15
DATA 240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,240
DATA 255,255,255,255,255,255,255,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,59,102,102,102,102,102,62,6,6,15
DATA 0,0,0,0,0,0,62,99,3,3,3,99,62,0,0,0
DATA 0,0,0,0,0,0,126,90,24,24,24,24,60,0,0,0
DATA 0,0,0,0,0,0,102,102,102,102,124,96,48,28,0,0
DATA 0,0,0,0,0,60,24,126,219,219,219,219,126,24,24,60
DATA 0,0,0,0,0,0,99,54,28,28,28,54,99,0,0,0
DATA 0,0,0,0,0,0,102,102,102,102,102,254,192,0,0,0
DATA 0,0,0,0,0,0,102,102,102,126,124,96,96,0,0,0
DATA 0,0,0,0,0,0,107,107,107,107,107,107,127,0,0,0
DATA 0,0,0,0,0,0,107,107,107,107,107,107,127,192,192,0
DATA 0,0,0,0,0,0,31,13,12,124,204,204,126,0,0,0
DATA 0,0,0,0,0,0,99,99,99,111,123,123,111,0,0,0
DATA 0,0,0,0,0,0,15,6,6,62,102,102,63,0,0,0
DATA 0,0,0,0,0,0,60,102,96,120,96,102,60,0,0,0
DATA 0,0,0,0,0,0,115,219,219,223,219,219,115,0,0,0
DATA 0,0,0,0,0,0,124,102,102,102,124,104,102,0,0,0
DATA 0,0,108,0,254,140,12,44,60,44,12,140,254,0,0,0
DATA 0,0,0,0,0,102,0,60,102,126,6,102,60,0,0,0
DATA 0,0,0,0,12,24,48,96,48,24,12,0,126,0,0,0
DATA 0,0,0,0,48,24,12,6,12,24,48,0,126,0,0,0
DATA 0,0,0,112,216,216,24,24,24,24,24,24,24,24,24,24
DATA 24,24,24,24,24,24,24,24,24,27,27,27,14,0,0,0
DATA 0,0,0,0,0,24,24,0,126,0,24,24,0,0,0,0
DATA 0,0,0,0,0,0,110,59,0,110,59,0,0,0,0,0
DATA 0,28,54,54,28,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,24,24,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,24,0,0,0,0,0,0,0
DATA 0,0,240,48,48,48,48,48,55,54,54,60,56,0,0,0
DATA 0,0,0,0,51,243,243,247,63,251,51,51,51,0,0,0
DATA 0,28,54,24,12,38,62,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,62,62,62,62,62,62,62,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
SUB FadePAL
' Палитра гаснет
FOR Prc% = 0 TO 32
OUT &H3C8, 0: Kf! = (32 - Prc%) / 32
FOR i% = 0 TO 15
OUT &H3C9, Re%(i%) * Kf!
OUT &H3C9, Gr%(i%) * Kf!
OUT &H3C9, Bl%(i%) * Kf!
NEXT i%
f! = TIMER: WHILE TIMER = f!: Kb$ = INKEY$: WEND
NEXT
END SUB
SUB LoadBMP (x%, y%, FLName$, PALMode%)
DIM FilePL&
TekF% = FREEFILE
OPEN "B", TekF%, FLName$
GET #TekF%, , FHead ' Заголовок файла
' Если файл явл. *.BMP*
IF FHead.BmID = 19778 THEN
GET #TekF%, , BMPHead ' Bitmap Заголовок
IF PALMode% = 1 THEN
' Сканируем палитру
FOR i% = 0 TO 15
OUT &H3C7, i%
Re%(i%) = INP(&H3C9): Gr%(i%) = INP(&H3C9): Bl%(i%) = INP(&H3C9)
NEXT i%
' Палитра гаснет
FOR Prc% = 0 TO 32
OUT &H3C8, 0: Kf! = (32 - Prc%) / 32
FOR i% = 0 TO 15
OUT &H3C9, Re%(i%) * Kf!
OUT &H3C9, Gr%(i%) * Kf!
OUT &H3C9, Bl%(i%) * Kf!
NEXT i%
f! = TIMER: WHILE TIMER = f!: Kb$ = INKEY$: WEND
NEXT
ELSEIF PALMode% = 0 THEN
FOR i% = 0 TO 15
OUT &H3C8, i%: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
NEXT i%
END IF
' Читаем палитру из файла
FOR i% = 0 TO 15
GET #1, , FilePL&
Re%(i%) = ((FilePL& AND &HFF0000) \ 262144) AND 63
Gr%(i%) = ((FilePL& AND &HFF00) \ 1024) AND 63
Bl%(i%) = ((FilePL& AND &HFF) \ 4) AND 63
NEXT i%
IF BMPHead.BitDepth = 8 THEN ' Если файл 8 бит, то грузим
' Блок вывода изображения
DIM LoadSt AS STRING * 640 ' Читаем блоками
DIM BPtr&, YSz&
BPtr& = VARPTR(LoadSt)
DEF SEG = VARSEG(LoadSt)
SEEK #TekF%, FHead.BmOFFSET
YSz& = BMPHead.BmpSizeY - 1
FOR iY& = 0 TO YSz&
GET #TekF%, , LoadSt ' Загружаем блок
FOR iX& = 0 TO BMPHead.BmpSizeX - 1
PSET (iX& + x%, YSz& - iY& + y%), PEEK(iX& + BPtr&)
NEXT
NEXT
DEF SEG
' Палитра загарается
FOR Prc% = 0 TO 32
OUT &H3C8, 0: Kf! = Prc% / 32
FOR i% = 0 TO 15
OUT &H3C9, INT(Re%(i%) * Kf!)
OUT &H3C9, INT(Gr%(i%) * Kf!)
OUT &H3C9, INT(Bl%(i%) * Kf!)
NEXT
f! = TIMER: WHILE TIMER = f!: Kb$ = INKEY$: WEND
NEXT
END IF
END IF
CLOSE TekF%
END SUB
SUB Menu
FOR i% = -51 TO 0
LINE (i%, 0)-(i% + 50, 50), 0
LINE (639 - i% - 3, 479)-(639 - i% - 53, 429), 0
NEXT
FOR i% = 0 TO 640 STEP 6
FOR j% = 0 TO 2
LINE (i% + j%, 0)-(i% + j% + 50, 50), 1
LINE (i% + j% + 3, 0)-(i% + j% + 53, 50), 2
LINE (639 - i% - j%, 479)-(639 - i% - j% - 50, 429), 2
LINE (639 - i% - j% - 3, 479)-(639 - i% - j% - 53, 429), 1
NEXT
NEXT
LINE (0, 0)-(639, 479), 7, B ' Серая рамка программы
LINE (1, 51)-(638, 428), 0, BF ' Очищаем область
PrintFillXYCntr 320, 150, "М Е Н Ю", 3, 0
Vb% = 1: Rdr% = 1
' Цикл выбора варианта
DO: Kb$ = INKEY$
IF Kb$ = CHR$(0) + "H" AND Vb% > 0 THEN Vb% = Vb% - 1: Rdr% = 1
IF Kb$ = CHR$(0) + "P" AND Vb% < 3 THEN Vb% = Vb% + 1: Rdr% = 1
' Отрисовка окантовки выбора
IF Rdr% = 1 THEN
Rdr% = 0
FOR St% = 0 TO 3
LINE (250, St% * 20 + 198)-(400, St% * 20 + 218), 0, B
NEXT
LINE (250, Vb% * 20 + 198)-(400, Vb% * 20 + 218), 11, B
nc% = 7: IF Vb% = 0 THEN nc% = 14
PrintFillXYCntr 320, 200, MenuTx$(0), nc%, 0
nc% = 7: IF Vb% = 1 THEN nc% = 14
PrintFillXYCntr 320, 220, MenuTx$(1), nc%, 0
nc% = 7: IF Vb% = 2 THEN nc% = 14
PrintFillXYCntr 320, 240, MenuTx$(2), nc%, 0
nc% = 7: IF Vb% = 3 THEN nc% = 14
PrintFillXYCntr 320, 260, MenuTx$(3), nc%, 0
END IF
LOOP UNTIL Kb$ = CHR$(13)
END SUB
SUB PrepareALL
' Варианты меню
MenuTx$(0) = "Справка"
MenuTx$(1) = "Тест"
MenuTx$(2) = "Результат"
MenuTx$(3) = "Выход"
' Палитра
PALETTE
OUT &H3C8, 1: OUT &H3C9, 8: OUT &H3C9, 8: OUT &H3C9, 8
OUT &H3C8, 2: OUT &H3C9, 13: OUT &H3C9, 13: OUT &H3C9, 13
OUT &H3C8, 3: OUT &H3C9, 18: OUT &H3C9, 18: OUT &H3C9, 18
OUT &H3C8, 9: OUT &H3C9, 0: OUT &H3C9, 32: OUT &H3C9, 63
' Читаем ВОПРОСЫ и ВАРИАНТЫ
FOR i% = 0 TO 19
READ Voprosi$(i%) ' Читаем строку вопрос
READ Verno%(i%) ' Номер верного варианта ответа
FOR v% = 0 TO 3 ' Цикл на 4 повторения
READ Varianty$(i%, v%) ' Читаем строку каждого варианта
NEXT
NEXT
' Таблица степеней двойки
FOR i% = 0 TO 8: PowTB%(i%) = 2 ^ i%: NEXT
' Загрузка расширенной раскладки из DATA
FOR i% = 0 TO 127: FOR s% = 0 TO 15
READ Charset%(i% + 128, s%)
NEXT s%, i%
' Загрузка обычной раскладки из системного шрифта
FOR i% = 0 TO 127
LOCATE 1, 1: PRINT CHR$(i%)
FOR s% = 0 TO 15
SU% = 0
FOR x% = 0 TO 8
IF POINT(x%, s%) <> 0 THEN SU% = SU% + PowTB%(x%)
NEXT
Charset%(i%, s%) = SU%
NEXT
NEXT: CLS
END SUB
SUB PrintFillXY (x%, y%, Phrase$, Cvt1%, Cvt2%)
Cvt1% = -(Cvt1% - Cvt2%)
DL% = LEN(Phrase$) - 1
FOR s% = 0 TO DL%
xpls% = s% * 9: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iY% = 0 TO 15
FOR iX% = 0 TO 8
Cv% = Cvt2% + ((Charset%(Lit%, iY%) AND PowTB%(iX%)) > 0) * Cvt1%
PSET (iX% + x% + xpls%, iY% + y%), Cv%
NEXT
NEXT
NEXT
END SUB
SUB PrintFillXYCntr (xc%, y%, Phrase$, Cvt1%, Cvt2%)
Cvt1% = -(Cvt1% - Cvt2%)
DL% = LEN(Phrase$) - 1
xmin% = (DL% * 9) \ 2
FOR s% = 0 TO DL%
xpls% = s% * 9 - xmin%: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iY% = 0 TO 15
FOR iX% = 0 TO 8
Cv% = Cvt2% + ((Charset%(Lit%, iY%) AND PowTB%(iX%)) > 0) * Cvt1%
PSET (iX% + xc% + xpls%, iY% + y%), Cv%
NEXT
NEXT
NEXT
END SUB
SUB PrintXY (x%, y%, Phrase$, Cvt%)
DL% = LEN(Phrase$) - 1
FOR s% = 0 TO DL%
xpls% = s% * 9: Lit% = ASC(MID$(Phrase$, s% + 1, 1))
FOR iY% = 0 TO 15
FOR iX% = 0 TO 8
IF (Charset%(Lit%, iY%) AND PowTB%(iX%)) > 0 THEN
PSET (iX% + x% + xpls%, iY% + y%), Cvt%
END IF
NEXT
NEXT
NEXT
END SUB
SUB Rezultat
' Результаты теста
IF VoprNum% = 20 THEN
LINE (1, 51)-(638, 428), 1, BF ' Очищаем область
LINE (50, 90)-(590, 200), 0, BF ' Очищаем область чёрным
LINE (50, 90)-(590, 200), 15, B ' Обводим белой рамкой
PrintFillXY 60, 100, "Уважаемый(ая) " + MyName$ + " вы набрали", 7, 0
PrintFillXY 150, 120, STR$(Score%) + " правильных ответов", 10, 0
PrintFillXY 60, 140, "по классификации данного теста вам соответствует оценка:", 7, 0
' Вычисление оценки
SELECT CASE Score%
CASE 0 TO 10: Ball$ = " 2"
CASE 11 TO 13: Ball$ = " 3"
CASE 14 TO 17: Ball$ = " 4"
CASE 18 TO 20: Ball$ = " 5"
CASE ELSE
END SELECT
PrintFillXY 150, 160, Ball$, 10, 0
ELSE
LINE (1, 51)-(638, 428), 0, BF ' Очищаем область
PrintFillXYCntr 320, 230, "ТЕСТ НЕ ПРОЙДЕН!", 12, 0
END IF
WHILE INKEY$ = "": WEND
END SUB
SUB Spravka
CLS
LINE (3, 3)-(637, 460), 3, B
PrintXY 285, 60, "<СПРАВКА>", 10
PrintXY 30, 110, "Данная программа представляет собой тест по теме <ОБЖ>, состоящий", 6
PrintXY 30, 126, "из 20 вопросов. На каждый вопрос предлагается 3 варианта ответа.", 6
PrintXY 30, 142, "Выбор ответа осуществляется с помощью нажатия клавиш вверх, вниз.", 6
PrintXY 30, 158, "Подтверждение выбранного пункта клавишей Enter", 6
PrintXY 30, 174, "Для начала тестирования необходимо нажать любую клавишу.", 6
PrintXY 30, 190, "Результаты будут отображены сразу после прохождения теста.", 6
PrintXY 380, 272, "Автор теста: Смирнов Дмитрий", 9
PrintXY 380, 288, "ученик 44 школы", 9
PrintXY 290, 400, "2011 год", 3
COLOR 8
LOCATE 27, 18
Sost% = 0
WHILE INKEY$ = ""
IF Sost% <> (INT((TIMER - INT(TIMER)) * 10) AND 2) THEN
Sost% = (INT((TIMER - INT(TIMER)) * 10) AND 2) \ 2
PrintXY 120, 432, "Для начала тестирования нажмите любую клавишу", 2 + Sost%
END IF
WEND
END SUB
SUB Test
LINE (0, 0)-(639, 479), 1, BF
FOR i% = 0 TO 640 STEP 6
FOR j% = 0 TO 2
LINE (i% + j%, 0)-(i% + j% + 50, 50), 2
LINE (i% + j% + 3, 0)-(i% + j% + 53, 50), 3
LINE (639 - i% - j%, 479)-(639 - i% - j% - 50, 429), 3
LINE (639 - i% - j% - 3, 479)-(639 - i% - j% - 53, 429), 2
NEXT
NEXT
LINE (0, 0)-(639, 479), 7, B ' Серая рамка программы
LINE (30, 290)-(610, 428), 0, BF ' Чёрная облсть под текстом
PrintXY 200, 200, "Введите ваше имя:", 11
PrintXY 100, 293, "Если вы запускаете программу из под ОС WINDOWS то", 7
PrintXY 40, 309, "русская раскладка включается через правый CTRL+SHIFT", 10
PrintXY 40, 325, "английская раскладка включается через левый CTRL+SHIFT", 10
PrintXY 100, 341, "Если вы запускаете программу из под ОС MS-DOS", 7
PrintXY 100, 357, "и используете резидентные драйверы, то вариантов", 7
PrintXY 100, 373, "переключения раскладки может быть несколько:", 7
PrintXY 40, 389, "Правый SHIFT\левый SHIFT, оба SHIFT'а, оба CTRL", 10
PrintXY 40, 405, "Правый ALT+SHIFT, правый CTRL\левый CTRL", 10
' Ввод имени перед тестом
Rdr% = 1
DO: Kb$ = INKEY$
' Удаление символа
IF Kb$ = CHR$(8) AND LEN(MyName$) > 0 THEN
MyName$ = LEFT$(MyName$, LEN(MyName$) - 1): Rdr% = 1
END IF
' Добавка символа
IF (Kb$ > "@" AND Kb$ < "[") OR (Kb$ > "`" AND Kb$ < "{") THEN
IF LEN(MyName$) < 15 THEN
MyName$ = MyName$ + Kb$: Rdr% = 1
END IF
ELSEIF (Kb$ > "" AND Kb$ < "░") OR (Kb$ > "▀" AND Kb$ < "Є") THEN
IF LEN(MyName$) < 15 THEN
MyName$ = MyName$ + Kb$: Rdr% = 1
END IF
END IF
IF Rdr% = 1 THEN PrintFillXYCntr 320, 220, " " + MyName$ + "_ ", 15, 1
Rdr% = 0
LOOP UNTIL Kb$ = CHR$(13)
LINE (1, 51)-(638, 428), 1, BF ' Очищаем область
' Сам тест
VoprNum% = 0 ' Начнём с первого вопроса
Vo% = 0 ' Вариант ответа
Score% = 0 ' Сколько юзер ответил
Izm% = 1 ' Отобразить выбор
' Печатаем первый вопрос перед циклом
PrintFillXYCntr 320, 55, "ВОПРОС №" + STR$(VoprNum% + 1), 15, 1
PrintXY 50, 100, "Внимание вопрос:", 10
' Раскладываем вопрос по строкам
Tx1$ = LEFT$(Voprosi$(VoprNum%), 65)
IF LEN(Voprosi$(VoprNum%)) > 65 THEN
Tx2$ = MID$(Voprosi$(VoprNum%), 66, 65)
END IF
IF LEN(Voprosi$(VoprNum%)) > 130 THEN
Tx3$ = MID$(Voprosi$(VoprNum%), 131, 65)
END IF
' Печатаем вопрос
PrintXY 20, 150, Tx1$, 7
PrintXY 20, 166, Tx2$, 7
PrintXY 20, 182, Tx3$, 7
' Печатаем варианты
PrintXY 100, 250, "1] " + LEFT$(Varianty$(VoprNum%, 0), 50), 9
PrintXY 127, 266, MID$(Varianty$(VoprNum%, 0), 51), 9
PrintXY 100, 290, "2] " + LEFT$(Varianty$(VoprNum%, 1), 50), 9
PrintXY 127, 306, MID$(Varianty$(VoprNum%, 1), 51), 9
PrintXY 100, 330, "3] " + LEFT$(Varianty$(VoprNum%, 2), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 2), 51), 9
PrintXY 100, 370, "4] " + LEFT$(Varianty$(VoprNum%, 3), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 3), 51), 9
' Цикл выбора варианта
DO: Kb$ = INKEY$
IF Kb$ = CHR$(0) + "H" AND Vo% > 0 THEN Vo% = Vo% - 1: Izm% = 1
IF Kb$ = CHR$(0) + "P" AND Vo% < 3 THEN Vo% = Vo% + 1: Izm% = 1
' Отрисовка окантовки выбора
IF Izm% = 1 THEN
Izm% = 0
FOR St% = 0 TO 3
Dln% = LEN(Varianty$(VoprNum%, St%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, St% * 40 + 245)-(130 + 9 * (1 + Dln%), St% * 40 + 270 + Vis%), 1, B
NEXT
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 10, B
END IF
IF Kb$ = CHR$(13) THEN
' Проверка верности выбора
IF Verno%(VoprNum%) = Vo% + 1 THEN
Score% = Score% + 1
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 10, BF
PrintXY 100, Vo% * 40 + 250 + Vis% \ 2, "Верно!", 0
ELSE
Dln% = LEN(Varianty$(VoprNum%, Vo%))
IF Dln% > 50 THEN Dln% = 50: Vis% = 16 ELSE Vis% = 0
LINE (90, Vo% * 40 + 245)-(130 + 9 * (1 + Dln%), Vo% * 40 + 270 + Vis%), 12, BF
PrintXY 100, Vo% * 40 + 250 + Vis% \ 2, "Неправильно!", 0
END IF
f! = TIMER: WHILE TIMER < f! + 1: Kb$ = INKEY$: WEND ' Ожидание
VoprNum% = VoprNum% + 1 ' Инкремент вопроса
IF VoprNum% = 20 THEN EXIT DO ' Выход если закончились вопр.
Izm% = 1 ' Для отрисовки выбора
LINE (1, 51)-(638, 428), 1, BF ' Очищаем область
' Раскладываем вопрос по строкам
Tx1$ = LEFT$(Voprosi$(VoprNum%), 65): Tx2$ = "": Tx3$ = ""
IF LEN(Voprosi$(VoprNum%)) > 65 THEN
Tx2$ = MID$(Voprosi$(VoprNum%), 66, 65)
END IF
IF LEN(Voprosi$(VoprNum%)) > 130 THEN
Tx3$ = MID$(Voprosi$(VoprNum%), 131, 65)
END IF
' Заголовок вопроса
PrintFillXYCntr 320, 55, "ВОПРОС №" + STR$(VoprNum% + 1), 15, 1
PrintXY 50, 100, "Внимание вопрос:", 10
' Печатаем вопрос
PrintXY 20, 150, Tx1$, 9
PrintXY 20, 166, Tx2$, 9
PrintXY 20, 182, Tx3$, 9
' Печатаем варианты
PrintXY 100, 250, "1] " + LEFT$(Varianty$(VoprNum%, 0), 50), 9
PrintXY 127, 266, MID$(Varianty$(VoprNum%, 0), 51), 9
PrintXY 100, 290, "2] " + LEFT$(Varianty$(VoprNum%, 1), 50), 9
PrintXY 127, 306, MID$(Varianty$(VoprNum%, 1), 51), 9
PrintXY 100, 330, "3] " + LEFT$(Varianty$(VoprNum%, 2), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 2), 51), 9
PrintXY 100, 370, "4] " + LEFT$(Varianty$(VoprNum%, 3), 50), 9
PrintXY 127, 346, MID$(Varianty$(VoprNum%, 3), 51), 9
END IF
LOOP UNTIL Kb$ = CHR$(27)
' Результаты теста
IF VoprNum% = 20 THEN
LINE (1, 51)-(638, 428), 1, BF ' Очищаем область
LINE (50, 90)-(590, 200), 0, BF ' Очищаем область чёрным
LINE (50, 90)-(590, 200), 15, B ' Обводим белой рамкой
PrintFillXYCntr 320, 60, "Тест пройден успешно!", 10, 1
'PrintFillXY 60, 100, "Уважаемый(ая) " + MyName$ + " вы набрали", 7, 0
'PrintFillXY 150, 120, STR$(Score%) + " правильных ответов", 10, 0
'PrintFillXY 60, 140, "по классификации данного теста вам соответствует оценка:", 7, 0
' Вычисление оценки
'SELECT CASE Score%
' CASE 0 TO 10: Ball$ = " 2"
' CASE 11 TO 13: Ball$ = " 3"
' CASE 14 TO 17: Ball$ = " 4"
' CASE 18 TO 20: Ball$ = " 5"
' CASE ELSE
'END SELECT
'PrintFillXY 150, 160, Ball$, 10, 0
ELSE
LINE (1, 51)-(638, 428), 1, BF ' Очищаем область
PrintFillXYCntr 320, 230, "ТЕСТ ПРЕРВАН!", 12, 1
END IF
END SUB
SUB Zagolovok
LoadBMP 0, 0, "TEST1.BMP", 0
WHILE INKEY$ = "": WEND
FadePAL
CLS
END SUB
Тестирование выполнено в программе QB64 ( Скачать )