Создание текстового квеста на Visual Basic 6

@Phoenix97 · Регистрация: 30.06.2013

Студворк — интернет-сервис помощи студентам

Возникла такая задача: после ввода текста в TextBox необходимо подтвердить его нажатием клавиши Enter. В принципе, можно было бы сделать отдельную кнопку, но тогда в игре пришлось бы использовать мышку, что крайне неудобно.
Так же я был бы рад узнать, как сделать так, что бы после нажатия Enter текст в TextBox очищался.
Заранее благодарен за ответ.

morgann55 · 05.08.2013, 21:01

Сообщение от Phoenix97

Так если m не повышать, программа будет удалять только первую строку, а если сделать m = m - 1 то вообще выдаст ошибку.

Ну ты через какую-то переменную выбираешь Номер следующего вопроса, вот ЭТУ переменную после удаления строки не повышай - оставь такую как была....

@Phoenix97 · 05.08.2013, 21:10 **[ТС]**

Сообщение от morgann55

Ну ты через какую-то переменную выбираешь Номер следующего вопроса, вот ЭТУ переменную после удаления строки не повышай - оставь такую как была...

Наверное, я чего-то не понимаю, поскольку m и есть та переменная, которая меняет номер следующего вопроса...
И если её не менять, то будет то, что я описал выше.

@The trick · 05.08.2013, 21:26

Сообщение от Phoenix97

The trick, извини, просто не совсем понял, как это сделать. Если не сложно, можешь привести пример?

Могу

Visual Basic
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
Option Explicit
 
Private Type tRecord
    Text As String
    Visible As Boolean
End Type
 
Dim Rec() As tRecord
 
Private Sub Form_Load()
    Dim I As Long
    
    ReDim Rec(5)
    
    Rec(0).Text = "VB 6 (0)": Rec(0).Visible = True
    Rec(1).Text = "Asm (1)": Rec(1).Visible = True
    Rec(2).Text = "C++ (2)": Rec(2).Visible = True
    Rec(3).Text = "Pascal (3)": Rec(3).Visible = True
    Rec(4).Text = "C# (4)": Rec(4).Visible = True
    Rec(5).Text = "Java (5)": Rec(5).Visible = True
    
    For I = 0 To UBound(Rec)
        List1.AddItem Rec(I).Text
    Next
End Sub
 
Private Sub List1_Click()
    Dim I As Long, Index As Long
    Do Until I > UBound(Rec)
        If Rec(I).Visible Then Index = Index + 1
        If Index = List1.ListIndex + 1 Then Me.Caption = "Index = " & I: Rec(I).Visible = False: Exit Do
        I = I + 1
    Loop
    List1.RemoveItem (List1.ListIndex)
End Sub

@gaw · 05.08.2013, 21:58

вариант без использования Select, если правильно понял, что надо

Visual Basic
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
Dim t$(), otv$(), i%, n%
 
Private Sub Form_Load()
  n = 5
  atv_List1 n
End Sub
 
Private Sub List1_Click()
i = List1.ListIndex
List1.RemoveItem i
MsgBox t(i + 1) & vbNewLine & otv(i + 1)
End Sub
 
Sub atv_List1(k%)
ReDim t(k), otv(k)
  For i = 1 To k
    List1.AddItem "Вопрос " & i
    t(i) = "Текст вопроса №" & i
    otv(i) = "Ожидаемый текст ответа на вопрос №" & i
Next i
End Sub
 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And List1.ListCount = 0 Then
   atv_List1 n
End If
End Sub

SoftIce · 05.08.2013, 21:59

Тоже кое-что набросал.
Посмотри, может пригодится

Вопросы и ответы - в отдельном текстовом файле такой структуры:

Вопрос №1
ответ №1
ответ №2
ответ №3
ответ №4
Вопрос №2
ответ №1
----------

Visual Basic
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
Private Type Questions
    'QuNumber As Integer
    QuHasBeen As Boolean
    Question As String
End Type
 
Private Type Answers
    'AnNumber As Integer
    AnHasBeen As Boolean
    Answer As String
End Type
 
Dim Qu() As Questions             ' Массив структур вопросов
Dim An() As Answers               ' Массив структур оветов
Dim countQuestions As Integer     ' Количество вопросов
Const countAnswers As Integer = 4 ' Количество ответов на каждый вопрос
Dim i As Integer, j As Integer
Dim currentQuestion As Integer    ' Номер текущего вопроса
Dim currentAnswer As Integer      ' Номер текущего ответа
 
Private Sub Form_Load()
    Dim St, ff As Integer, n As Integer
    ff = FreeFile
    Open App.Path & "\QuestionsAnswers.txt" For Input As #ff
         Do While Not EOF(ff)
           Line Input #ff, St
           n = n + 1        'считаем строки в текстовом файле
         Loop
    Close #ff
    countQuestions = n / (countAnswers + 1)
    ReDim Qu(1 To countQuestions), An(1 To countQuestions, 1 To countAnswers)
    ' Записываем вопросы и ответы из файла в соответствующие массивы структур
    Open App.Path & "\QuestionsAnswers.txt" For Input As #ff
          For i = 1 To countQuestions
              Line Input #ff, Qu(i).Question
              List1.AddItem Qu(i).Question
              For j = 1 To countAnswers
                   Line Input #ff, An(i, j).Answer
              Next j
          Next i
    Close #ff
End Sub
 
Private Sub List1_Click()
    currentQuestion = List1.ListIndex + 1
    FillList
    Label1.Caption = Qu(currentQuestion).Question
    Label2.Caption = ""
End Sub
 
Private Sub List2_Click()
    For j = 1 To countAnswers
        If List2.List(List2.ListIndex) = An(currentQuestion, j).Answer Then currentAnswer = j
    Next j
    An(currentQuestion, currentAnswer).AnHasBeen = True
    Label2.Caption = An(currentQuestion, currentAnswer).Answer
    FillList
End Sub
 
Sub FillList()
    List2.Clear
    For j = 1 To countAnswers
       If Not An(currentQuestion, j).AnHasBeen Then
           List2.AddItem An(currentQuestion, j).Answer
       End If
    Next j
End Sub

@Phoenix97 · 05.08.2013, 22:10 **[ТС]**

Не по теме:

Всё это определённо пригодится, спасибо всем!

SoftIce · 05.08.2013, 22:18

А вот еще, чтобы использованные вопросы тоже убирались из листбокса.
Получается типа диалога.

Visual Basic
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
Private Type Questions
    'QuNumber As Integer
    QuHasBeen As Boolean
    Question As String
End Type
 
Private Type Answers
    'AnNumber As Integer
    AnHasBeen As Boolean
    Answer As String
End Type
 
Dim Qu() As Questions             ' Массив структур вопросов
Dim An() As Answers               ' Массив структур оветов
Dim countQuestions As Integer     ' Количество вопросов
Const countAnswers As Integer = 4 ' Количество ответов на каждый вопрос
Dim i As Integer, j As Integer
Dim currentQuestion As Integer    ' Номер текущего вопроса
Dim currentAnswer As Integer      ' Номер текущего ответа
 
Private Sub Form_Load()
    Dim St, ff As Integer, n As Integer
    ff = FreeFile
    Open App.Path & "\QuestionsAnswers.txt" For Input As #ff
         Do While Not EOF(ff)
           Line Input #ff, St
           n = n + 1        'считаем строки в текстовом файле
         Loop
    Close #ff
    countQuestions = n / (countAnswers + 1)
    ReDim Qu(1 To countQuestions), An(1 To countQuestions, 1 To countAnswers)
    ' Записываем вопросы и ответы из файла в соответствующие массивы структур
    Open App.Path & "\QuestionsAnswers.txt" For Input As #ff
          For i = 1 To countQuestions
              Line Input #ff, Qu(i).Question
              List1.AddItem Qu(i).Question
              For j = 1 To countAnswers
                   Line Input #ff, An(i, j).Answer
              Next j
          Next i
    Close #ff
End Sub
 
Private Sub List1_Click()
    For j = 1 To countQuestions
        If List1.List(List1.ListIndex) = Qu(j).Question Then currentQuestion = j
    Next j
    Qu(currentQuestion).QuHasBeen = True
    Text1.Text = Text1.Text & "Вопрос : " & Qu(currentQuestion).Question & vbCrLf
    FillList
    List1.Clear
End Sub
 
Private Sub List2_Click()
    For j = 1 To countAnswers
        If List2.List(List2.ListIndex) = An(currentQuestion, j).Answer Then currentAnswer = j
    Next j
    An(currentQuestion, currentAnswer).AnHasBeen = True
   ' Label2.Caption = An(currentQuestion, currentAnswer).Answer
    Text1.Text = Text1.Text & "Ответ : " & An(currentQuestion, currentAnswer).Answer & vbCrLf & vbCrLf
    FillList
    List2.Clear
End Sub
 
Sub FillList()
    'List1.Clear: List2.Clear
    For j = 1 To countAnswers
       If Not An(currentQuestion, j).AnHasBeen Then
           List2.AddItem An(currentQuestion, j).Answer
       End If
       If Not Qu(j).QuHasBeen Then
           List1.AddItem Qu(j).Question
       End If
    Next j
End Sub

morgann55 · 05.08.2013, 23:39

Вот сделал чтоб всё управлялось с клавиатуры:

Visual Basic
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
Dim m%
'---------------
Private Sub form_load()
'For i = 0 To 10: List1.List(i) = Str(i):Next i ' это для проверки
List1.ListIndex = 0
m = 0
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
List1.ListIndex = m ' на случай потери фокуса
If KeyCode = 13 Then
List1.RemoveItem (m): If m > List1.ListCount - 1 Then m = List1.ListCount - 1
List1.ListIndex = m
End If
If KeyCode = 40 Then
m = m + 1: If m > List1.ListCount - 1 Then m = List1.ListCount - 1
End If
If KeyCode = 38 Then
m = m - 1: If m < 0 Then m = 0
End If
 
Select Case List1.List(m) 'èëè Select Case m - ñàì ðàçáåð¸øüñÿ ÷òî òåáå íàäî
Case 1:
'<...>
Case 2:
'<...>
Case 3:
'<...>
'È ò.ä.
End Select
End Sub

(вроде ты так хотел...)
Если тебе уже подсказали лучшее решение, то в топку...

Добавлено через 38 минут
Может в самом начале процедуры Private Sub Form_KeyDown надо добавить

Visual Basic
1
List1.ListIndex = m ' на случай потери фокуса

(добавил на доп.правке)

Добавлено через 7 минут
А вообще лучше использовать Form_KeyUp, чтоб не было повторов...

@Phoenix97 · 06.08.2013, 00:03 **[ТС]**

morgann55, да, ваш вариант мне более всего подходит, однако пока он не совсем стабильно работает в программе, но думаю, смогу подогнать его под программу (или программу под него

)

morgann55 · 06.08.2013, 02:25

Ты при подгоне следи чтоб m и ИндексЛиста всегда были равны друг-другу !! Если понадобится кликать мышкой по Листу, то в процедуре клика пропиши обратное приравнивание:

Visual Basic
1
m = List1.ListIndex

Новые блоги и статьи Все статьи Все блоги /
Программное добавление префикса в нумерацию документов Maks 27.10.2026 Реализация из решения ниже выполнена в самописной конфигурации на БСП (помощь начинающему коллеге). Задача: Программно добавить префикс в нумерацию документов. Решение: В модуле объекта. . .	После закрытия оутлука продолжает висеть процесс в диспетчере задач Maks 27.10.2026 С недавнего времени в продакшене возникла проблема: при закрытии оутлука в диспетчере задач продолжал висеть процесс outlook. exe. Проблема возникла после установки MS Office 2021 LTSC на машинах, под. . .	Baragoz - DPS/HPS бот для WoW 3.3.5a, многоязычный AmbA 26.10.2026 Хотите ещё ботов? У меня есть один! А я пока отдохну от него. https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=12062&stc=1&d=1793007952 Инструкция внутри. https:/ / youtu. be/ VpfFZSUDGnQ. . .	Особенности gif сгенерированных в Си russiannick 21.10.2026 Рассмотрим генерацию gif файлов, которые в Си имеют свои особенности. Gif представляет собой графический формат популярный в интернете. Посмотрим на палитру. Gif файл сгенерированный в си отличается. . .
FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .	Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .

@Phoenix97 0 / 0 / 0 Регистрация: 30.06.2013 Сообщений: 29

	Создание текстового квеста на Visual Basic 6 30.06.2013, 23:02. Показов 6491. Ответов 49 Метки нет (Все метки) Возникла такая задача: после ввода текста в TextBox необходимо подтвердить его нажатием клавиши Enter. В принципе, можно было бы сделать отдельную кнопку, но тогда в игре пришлось бы использовать мышку, что крайне неудобно. Так же я был бы рад узнать, как сделать так, что бы после нажатия Enter текст в TextBox очищался. Заранее благодарен за ответ. 0

@Phoenix97
	05.08.2013, 22:10 [ТС]
	Не по теме: Всё это определённо пригодится, спасибо всем! 0

@Phoenix97 0 / 0 / 0 Регистрация: 30.06.2013 Сообщений: 29
	06.08.2013, 00:03 [ТС]
	morgann55, да, ваш вариант мне более всего подходит, однако пока он не совсем стабильно работает в программе, но думаю, смогу подогнать его под программу (или программу под него) 0

Создание текстового квеста на Visual Basic 6

Решение

Решение

Решение

Решение