"opros.bas"
DECLARE SUB relax ()
DECLARE SUB schet (bf$, jj!)
DECLARE SUB readf (bf$, jj!, fia$(), qu$(), ans%(), tqua%())
DECLARE SUB test (kk!, jj!, fia$(), qu$(), ans%(), tqua%())
DECLARE SUB make (bf$, jj!, fia$(), qu$(), ans%(), tqua%())
DECLARE SUB work (kk!, jj!, fia$(), qu$(), ans%(), tqua%())
0 :
CLS
PRINT " Режим работы: "
PRINT " 0 - end "
PRINT " 1 - тест "
PRINT " 2 - просмотр ответов "
PRINT " 3 - обзор общий "
PRINT " 4 - характеристики "
INPUT kk
IF kk = 0 THEN END
CLS
bf$ = "base.txt"
CALL schet(bf$, jj)
IF kk = 1 THEN jj = jj + 1
DIM qu$(120), fia$(jj), ans%(120, jj), tqua%(120, jj)
IF kk = 1 THEN jj = jj - 1
CALL readf(bf$, jj, fia$(), qu$(), ans%(), tqua%())
IF kk > 1 THEN GOTO 34
jj = jj + 1
PRINT jj
' ia$ = INPUT$(1)
fia$(jj) = fia$(0)
CALL test(kk, jj, fia$(), qu$(), ans%(), tqua%())
FOR i = 1 TO 200
SOUND i * 5 + 50, .1
NEXT
CALL make(bf$, jj, fia$(), qu$(), ans%(), tqua%())
34 :
IF kk = 1 THEN GOTO 35
CALL work(kk, jj, fia$(), qu$(), ans%(), tqua%())
35 :
RUN "opros.bas"
END
SUB make (bf$, jj, fia$(), qu$(), ans%(), tqua%())
'------------------------- обновление базы данных ---------------------------
OPEN bf$ FOR OUTPUT AS #1
WRITE #1, jj
'fia$(0) = " 0 00 лет * 00.00.00 * * 00.00.99 ....... "
'WRITE #1, fia$(0)
FOR i = 1 TO 120
WRITE #1, i, qu$(i)
NEXT i
FOR j = 1 TO jj
WRITE #1, j, fia$(j)
FOR i = 1 TO 120
WRITE #1, i, ans%(i, j), tqua%(i, j)
'PRINT i,qu$(i),ans%(i,j),tqua%(i,j)
NEXT i
NEXT j
CLOSE 1
END SUB
SUB readf (bf$, jj, fia$(), qu$(), ans%(), tqua%())
'------------------------- считывание базы данных ---------------------------
OPEN bf$ FOR INPUT AS #1
INPUT #1, jj
'INPUT #1, fia$(0)
FOR i = 1 TO 120
INPUT #1, ia, qu$(i)
NEXT i
FOR j = 1 TO jj
INPUT #1, ja, fia$(j)
FOR i = 1 TO 120
INPUT #1, ia, ans%(i, j), tqua%(i, j)
NEXT i
NEXT j
CLOSE #1
END SUB
SUB relax
'------------------------- релаксационная подрограмма -----------------------
FOR ir = 1 TO 25
PRINT " Отдыхаем! "
SLEEP 1
NEXT ir
CLS
FOR ir = 1 TO 25
PRINT " Работаем! Работаем! Работаем! Работаем! Работаем! Работаем! Работаем!"
NEXT ir
SLEEP 3
CLS
LOCATE 12, 35
PRINT " Готовы? "
ia$ = INPUT$(1)
CLS
END SUB
SUB schet (bf$, jj)
'------------------------- считывание счетчика списка -----------------------
OPEN bf$ FOR INPUT AS #1
INPUT #1, jj
'PRINT jj
' ia$ = INPUT$(1)
CLOSE #1
END SUB
SUB test (kk, jj, fia$(), qu$(), ans%(), tqua%())
'========================= тестирование =====================================
DIM akey%(120)
irel = 24
j = jj
INPUT "Фамилия и имя, например_ ТРУЛЬ ОЛЬГА : ", fia$(j)
INPUT "Полных лет, например_ 33 : ", fil$
INPUT "Дата рождения, например_ 06.10.1967 : ", fid$
fia$(j) = fia$(j) + " ( ),лет:" + fil$ + ", рожд:" + fid$ + " #" + DATE$
'------------------------- вводная инструкция -------------------------------
1 :
FOR i = 1 TO 200
SOUND i * 5 + 50, .1
NEXT
CLS
LOCATE 12, 1
PRINT j, fia$(j)
PRINT " Не нужно долго обдумывать ответ. Здесь нет хороших или плохих ответов."
PRINT " Отвечайть необходимо сразу, как только вопрос стал понятен."
PRINT " Если есть сомнения в ответе ДА или НЕТ, то необходимо: "
PRINT " - отвечать ДА, в случае ответа МОЖЕТ БЫТЬ ДА "
PRINT " - отвечать НЕТ, в случае ответа МОЖЕТ БЫТЬ НЕТ "
PRINT " Ответь: ДА, если инструкция понятна. "
LOCATE 22, 48
PRINT " Введи ответ (ДА-1, НЕТ-0):"
ia$ = INPUT$(1)
CLS
LOCATE 12, 1
PRINT " Нужно ли повторить инструкцию?"
LOCATE 22, 48
PRINT " Введи ответ (ДА-1, НЕТ-0):"
ia$ = INPUT$(1)
IF ia$ <> "1" AND ia$ <> "0" THEN GOTO 1
CLS
IF ia$ = "1" THEN GOTO 1
'------------------------- процедура опроса ---------------------------------
FOR i = 1 TO 120
IF i < 61 THEN io = i: GOTO 112
RANDOMIZE TIMER
slran = (tqu + 10 * (TIMER - INT(TIMER))) / 10
io = INT(120 * RND(slran))
111 :
IF io < 61 OR io > 120 THEN io = 120
IF akey%(io) <> 0 THEN io = io - 1: GOTO 111
112 :
BEEP
2 :
tqu = TIMER
rep:
LOCATE 12, 1
PRINT io, qu$(io)
LOCATE 21, 48
PRINT " Введи ответ (ДА-1, НЕТ-0):"
ia$ = INPUT$(1)
IF ia$ = "1" THEN ans%(io, j) = 1: anst$ = "ДА "
IF ia$ = "0" THEN ans%(io, j) = 0: anst$ = "НЕТ"
IF ia$ <> "1" AND ia$ <> "0" THEN GOTO 2
tqu = TIMER - tqu
IF tqu < 1 THEN GOTO 2
tqua%(io, j) = INT(10 * tqu)
PRINT " Ответ:", anst$
PRINT " Осталось вопросов:", (120 - i)
akey%(io) = 1
SLEEP 2 'delay 1
CLS
IF i = irel THEN irel = irel + 21: CALL relax
NEXT i
END SUB
SUB work (kk, jj, fia$(), qu$(), ans%(), tqua%())
'========================= работа с базой данных ============================
300 :
'------------------------- выборочный обзор ---------------------------------
IF kk <> 3 THEN GOTO 3
PRINT " Введи начальный вопрос:"
INPUT i1
PRINT " Введи конечный вопрос:"
INPUT i2
FOR i = i1 TO i2
PRINT " "
PRINT i, qu$(i)
FOR j = 1 TO jj
IF ans%(i, j) = 1 THEN anst$ = "ДА "
IF ans%(i, j) = 0 THEN anst$ = "НЕТ"
PRINT j; fia$(j); " ... "; anst$; INT(tqua%(i, j) / 10)
NEXT j
ia$ = INPUT$(1)
NEXT i
GOTO 26
'------------------------- просмотр по номеру -------------------------------
3 :
CLS
IF kk <> 4 THEN GOTO 41
FOR j = 1 TO jj
41 :
IF kk = 4 THEN GOTO 4
FOR j = 1 TO jj
PRINT j, fia$(j)
NEXT j
PRINT " Введи номер респондента по списку (0-отказ)"
INPUT j
IF j = 0 THEN GOTO 26
CLS
'------------------------- статистика ---------------------------------------
4 :
tqu = 0
tqumin = 110
tqumax = 0
stqu = 0
e = 0
n = 0
l = 0
iprn = 20
FOR i = 1 TO 120
IF i > 60 THEN GOTO 24
IF ans%(i, j) = 0 THEN GOTO 23
IF i = 1 OR i = 3 OR i = 9 OR i = 11 OR i = 14 OR i = 17 OR i = 19 OR i = 22 THEN e = e + 1
IF i = 25 OR i = 27 OR i = 30 OR i = 35 OR i = 38 OR i = 41 OR i = 43 OR i = 46 THEN e = e + 1
IF i = 49 OR i = 53 OR i = 57 THEN e = e + 1
IF i = 2 OR i = 5 OR i = 7 OR i = 10 OR i = 13 OR i = 15 OR i = 18 OR i = 21 THEN n = n + 1
IF i = 23 OR i = 26 OR i = 29 OR i = 31 OR i = 34 OR i = 37 OR i = 39 OR i = 42 THEN n = n + 1
IF i = 45 OR i = 47 OR i = 50 OR i = 52 OR i = 54 OR i = 56 OR i = 58 OR i = 60 THEN n = n + 1
IF i = 8 OR i = 16 OR i = 24 OR i = 28 OR i = 36 OR i = 44 THEN l = l + 1
GOTO 24
23 :
IF ans%(i, j) = 1 THEN GOTO 24
IF i = 6 OR i = 33 OR i = 51 OR i = 55 OR i = 59 THEN e = e + 1
IF i = 4 OR i = 12 OR i = 20 OR i = 32 OR i = 40 OR i = 48 THEN l = l + 1
24 :
IF kk = 4 THEN GOTO 25
IF ans%(i, j) = 1 THEN anst$ = "ДА "
IF ans%(i, j) = 0 THEN anst$ = "НЕТ"
PRINT i; qu$(i); anst$; INT(tqua%(i, j) / 10)
IF i = iprn THEN PRINT j, fia$(j): ia$ = INPUT$(1): iprn = iprn + 20: CLS
25 :
IF tqumin > tqua%(i, j) THEN tqumin = tqua%(i, j)
IF tqumax < tqua%(i, j) THEN tqumax = tqua%(i, j)
stqu = stqu + tqua%(i, j)
NEXT i
tqu = stqu / 120
PRINT j; fia$(j)
PRINT "Э:"; e; " Н:"; n; " Л:"; l; " T:"; INT(stqu / 10); "m:"; INT(tqu / 10); "mn:"; INT(tqumin / 10); "mx:"; INT(tqumax / 10); "D:"; INT((tqumax - tqumin) / 20)
'ia$ = INPUT$(1)
NEXT j
PRINT "Экстраверсия (норма 11-14)"; " Нейротизм (норма 10-15)"; " Ложь (норма 4-5)"
IF kk = 4 THEN GOTO 26
PRINT " Введи номер вопроса (0-отказ)"
INPUT i
IF i = 0 THEN GOTO 26
PRINT i, qu$(i)
FOR j = 1 TO jj
IF ans%(i, j) = 1 THEN anst$ = "ДА "
IF ans%(i, j) = 0 THEN anst$ = "НЕТ"
PRINT j; fia$(j); " ... "; anst$; INT(tqua%(i, j) / 10)
NEXT j
ia$ = INPUT$(1)
26 :
PRINT " Режим работы с базой данных: "
PRINT " 0 - выход "
PRINT " 2 - просмотр ответов "
PRINT " 3 - обзор общий "
PRINT " 4 - характеристики "
INPUT kk
IF kk > 0 THEN GOTO 300
END SUB
"base.txt"
0 1," Любишь ли ты шум и суету вокруг себя?...................... " 2," Часто ли ты нуждаешся в друзьях, которые могут поддержать?. " 3," Ты всегда находишь быстрый ответ, когда тебя просят?....... " 4," Бывает ли так, что ты раздражена чем-нибудь?............... " 5," Часто ли у тебя меняется настроение?....................... " 6," Тебе легче и приятнее с книгами, чем с ребятами?........... " 7," Часто ли тебе мешают уснуть разные мысли?.................. " 8," Ты всегда делаешь так, как тебе говорят?................... " 9," Любишь ли ты подшучивать над кем-нибудь?................... " 10,"Ты чувствовала себя несчастной без настоящей причины?...... " 11,"Можешь ли ты сказать, что ты веселый, живой человек?....... " 12,"Ты когда-нибудь нарушала правила поведения в школе?........ " 13,"Верно ли, что ты часто раздражена чем-нибудь?.............. " 14,"Нравится ли тебе все делать в быстром темпе?............... " 15,"Ты будешь переживать чуть не случившиеся неприятности?..... " 16,"Тебе можно доверить любую тайну?........................... " 17,"Можешь ли ты внести оживление в скучную компанию?.......... " 18,"Бывает ли, что у тебя без причины сильно бьется сердце?.... " 19,"Делаешь ли ты первый шаг, чтобы подружиться с кем-нибудь?.. " 20,"Ты когда-нибудь говорила неправду?......................... " 21,"Ты легко расстраиваешься, когда тебя критикуют?............ " 22,"Ты часто шутишь и рассказываешь смешные истории?........... " 23,"Ты часто чувствуешь себя усталой?.......................... " 24,"Ты всегда сначала делаешь уроки, а все остальное потом?.... " 25,"Ты обычно весела и всем довольна?.......................... " 26,"Обидчива ли ты?............................................ " 27,"Ты очень любишь общаться с другими ребятами?............... " 28,"Ты всегда выполняешь просьбы родных о помощи по хозяйству?. " 29,"У тебя бывают головокружения?.............................. " 30,"Ставили ли твои поступки других людей в неловкое положение? " 31,"Ты часто чувствуешь, что тебе что-нибудь надоело?.......... " 32,"Любишь ли ты иногда похвастаться?.......................... " 33,"Ты чаще всего молчишь в обществе незнакомых людей?......... " 34,"Волнуешься ли ты иногда так, что не усидеть на месте?...... " 35,"Ты обычно быстро принимаешь решения?....................... " 36,"Даже когда в классе нет учителя, ты никогда не шумишь? .... " 37,"Тебе часто снятся страшные сны?............................ " 38,"Можешь ли ты дать волю чувствам и повеселиться с друзьями?. " 39,"Тебя легко огорчить?....................................... " 40,"Случалось ли тебе плохо говорить о ком-нибудь?............. " 41,"Верно ли, что ты обычно действуешь, не раздумывая долго?... " 42,"Ты долго переживаешь, когда по-бывала в глупом положении?.. " 43,"Тебе очень нравятся шумные и веселые игры?................. " 44,"Ты всегда ешь то, что тебе подают?......................... " 45,"Тебе трудно ответить =нет=, когда тебя о чем-нибудь просят? " 46,"Ты любишь часто ходить в гости?............................ " 47,"Бывают ли такие моменты, когда тебе не хочется жить?....... " 48,"Была ли ты когда-нибудь груба с родителями?................ " 49,"Считают ли тебя ребята веселым и живым человеком?.......... " 50,"Ты часто отвлекаешься, когда делаешь уроки?................ " 51,"Ты чаще сидишь, чем активно участвуешь в общем веселье?.... " 52,"Тебе обычно бывает трудно уснуть из-за разных мыслей?...... " 53,"Бываешь ли ты совершенно уверена, что справишься с делом?.. " 54,"Бывает ли, что ты чувствуешь себя одинокой?................ " 55,"Ты стесняешься заговорить первой с новыми людьми?.......... " 56,"Ты часто спохватываешься, когда уже ничего не исправить?... " 57,"Когда на тебя кричат, ты тоже кричишь в ответ?............. " 58,"Бываешь ли ты иногда веселой или печальной без причины?.... " 59,"Трудно ли получить удовольствие от оживленной компании?.... " 60,"Часто приходится волноваться, сделав что-нибудь не подумав? " 61,"Я достаточно застенчива.................................... " 62,"Детям можно знать о сексе.................................. " 63,"Массаж доставляет мне наслаждение.......................... " 64,"Загорать на пляже без купальника - стыдно.................. " 65,"Я отворачиваюсь, когда по ТВ показывают обнаженных людей... " 66,"Девочкам и мальчикам можно видеть друг друга голыми........ " 67,"Мне интересны фильмы для взрослых.......................... " 68,"Приятнее дружить с мальчиками, чем с девочками............. " 69,"Все мои мысли известны моим друзьям и родителя............. " 70,"Родители часто придираются ко мне.......................... " 71,"Я вырасту такой, какой меня воспитают...................... " 72,"У меня есть тайны от родителей............................. " 73,"Иногда у меня возникало желание навсегда уйти из дома...... " 74,"Нужно всегда говорить только правду........................ " 75,"Родители плохо понимают меня............................... " 76,"Нужно уметь скрывать свои желания.......................... " 77,"Предназначение женщины в продолжении рода.................. " 78,"Муж в семье главнее жены................................... " 79,"Я боюсь воды............................................... " 80,"Актеры всегда хорошие вруны................................ " 81,"Сны всегда сбываются....................................... " 82,"Случай играет важную роль в моей жизни..................... " 83,"Моя судьба предопределена Богом............................ " 84,"На Марсе существует жизнь.................................. " 85,"Я боюсь оставаться одна в доме............................. " 86,"Добро всегда побеждает зло................................. " 87,"Душа может жить и без тела................................. " 88,"Я боюсь темноты............................................ " 89,"Болезни являются наказанием за грехи....................... " 90,"Мои фантазии бывают слишком правдоподобны.................. " 91,"Меня весьма тревожат возможные неудачи..................... " 92,"Я охотно могу прочесть стихи перед зрителями............... " 93,"Я предпочту быть зрителем, нежели участником концерта...... " 94,"Мне легко подражать чужим манерам.......................... " 95,"Быть проигравшим всегда горько............................. " 96,"Азартные игры мне безразличны.............................. " 97,"Быть некрасивой очень обидно............................... " 98,"Мне трудно справиться с волнением перед выходом на сцену... " 99,"Мне часто бывает ужасно скучно............................. " 100,"Я боюсь высоты............................................ " 101,"Охоту и рыбалку нужно запретить, чтобы НЕ мучать животных. " 102,"Я являюсь сторонницей разделения людей по цвету кожи...... " 103,"Больных СПИДом нужно изолировать от общества.............. " 104,"Животные лучше людей...................................... " 105,"Мне бывает стыдно за чужие проступки...................... " 106,"Смертная казнь бывает необходима.......................... " 107,"Сцены насилия в м/ф =Том и Джерри= достаточно забавны..... " 108,"Инвалиды являются обузой для здоровых людей............... " 109,"Я предпочитаю скорее выигрывать, чем проигрывать.......... " 110,"Нищета - самое ужасное в жизни............................ " 111,"Лучше быть обеспеченной домохозяйкой, чем бедной актрисой. " 112,"Нужно во всем быть первой................................. " 113,"Творческому человеку трудно устроиться в жизни............ " 114,"Для достижения своих целей все средства хороши............ " 115,"Классическая музыка мало тревожит меня.................... " 116,"У меня много подруг....................................... " 117,"В школе я всегда даю списывать............................ " 118,"Мне нравится учиться в школе.............................. " 119,"Мне нравится сочинять стихи............................... " 120,"Мне нравится рисовать..................................... "
Панов Андрей Александрович, 1964 г.р., образование высшее техническое,
кандидатский минимум, инженер-исследователь, независимый аналитик,
автор и руководитель проекта "Классика-Модерн", учредитель и куратор
Культурного Центра Чистых Искусств имени Айседоры Дункан, основатель и
руководитель Клуба Hеудачников(-ниц), г. Санкт-Петербург.
191011, С-Петербург, д/в, Панову А.А. (для писем) e-mail: panow@pisem.net
http://panow.narod.ru http://spb-freud.narod.ru http://troul.narod.ru