Форум программистов, компьютерный форум, киберфорум

DarKing1999

Форум программистов и сисадминов Киберфорум

Войти

Регистрация
Восстановить пароль

Сообщество

Консольный Minecraft | Visual basic

Запись от DarKing1999 размещена 28.01.2023 в 13:31

Показов 2100 Комментарии 2

Метки code blocks, console application, visual basic

В этом теме хотел бы поделиться своими наработками и в получившемся редакторе показать, как можно было бы сделать аналог консольной карты с элементами перемещения. Когда-то давно задался идеей создания сольной RPG в консольной стилистике, но встал ряд вопросов, которые до сих пор разбираю. Так, созданием данного редактора позволил мне облегчить работу, прекратив всё делать "ручками".

Код будет разделён на два класса. В первом будет вложена функция, позволяющая облегчить и уменьшить как объём кода, так и обеспечив гибкость изменения цветовых параметров.

Кликните здесь для просмотра всего текста

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Public Class SystemColorConsole
 
 Public Shared Sub WhiteFonfSys() 
    Console.ForegroundColor = ConsoleColor.White
    Console.CursorVisible = False
  End Sub
 
  Public Shared Sub BlackFonfSys()
    Console.ForegroundColor = ConsoleColor.Black
    Console.CursorVisible = False
  End Sub
 
  Public Shared Sub TxtRGB(ByVal _font As String, ByVal _back As String, ByVal _txt As String, ByVal _line As Boolean)
'Функция содержит в себе три параметра - цвет шрифта, цвет фона и логическую условность перехода на следующую строку.
'Четвёртый параметр содержит в себе элемент текста, который будет отображаться, что логично.
    Select Case _font
      Case "Black"
        Console.ForegroundColor = ConsoleColor.Black
      Case "DarkBlue"
        Console.ForegroundColor = ConsoleColor.DarkBlue
      Case "DarkGreen"
        Console.ForegroundColor = ConsoleColor.DarkGreen
      Case "DarkRed"
        Console.ForegroundColor = ConsoleColor.DarkRed
      Case "DarkMagenta"
        Console.ForegroundColor = ConsoleColor.DarkMagenta 
      Case "DarkYellow"
        Console.ForegroundColor = ConsoleColor.DarkYellow
      Case "Gray"
        Console.ForegroundColor = ConsoleColor.Gray
      Case "DarkGray"
        Console.ForegroundColor = ConsoleColor.DarkGray
      Case "Blue"
        Console.ForegroundColor = ConsoleColor.Blue
      Case "Green"
        Console.ForegroundColor = ConsoleColor.Green
      Case "Cyan"
        Console.ForegroundColor = ConsoleColor.Cyan 
      Case "Red"
        Console.ForegroundColor = ConsoleColor.Red
      Case "Magenta"
        Console.ForegroundColor = ConsoleColor.Magenta
      Case "Yellow"
        Console.ForegroundColor = ConsoleColor.Yellow
      Case "White"
        Console.ForegroundColor = ConsoleColor.White
    End Select
 
    Select Case _back
      Case "Black"
        Console.BackgroundColor = ConsoleColor.Black
      Case "DarkBlue"
        Console.BackgroundColor = ConsoleColor.DarkBlue
      Case "DarkGreen"
        Console.BackgroundColor = ConsoleColor.DarkGreen
      Case "DarkRed"
        Console.BackgroundColor = ConsoleColor.DarkRed
      Case "DarkMagenta"
        Console.BackgroundColor = ConsoleColor.DarkMagenta
      Case "DarkYellow"
        Console.BackgroundColor = ConsoleColor.DarkYellow
      Case "Gray"
        Console.BackgroundColor = ConsoleColor.Gray
      Case "DarkGray"
        Console.BackgroundColor = ConsoleColor.DarkGray
      Case "Blue"
        Console.BackgroundColor = ConsoleColor.Blue
      Case "Green"
        Console.BackgroundColor = ConsoleColor.Green
      Case "Cyan"
        Console.BackgroundColor = ConsoleColor.Cyan
      Case "Red"
        Console.BackgroundColor = ConsoleColor.Red
      Case "Magenta"
        Console.BackgroundColor = ConsoleColor.Magenta
      Case "Yellow"
        Console.BackgroundColor = ConsoleColor.Yellow
      Case "White"
        Console.BackgroundColor = ConsoleColor.White
    End Select
 
    Select Case _line
      Case True
        Console.WriteLine(_txt)
      Case False
        Console.Write(_txt)
    End Select
    Console.ForegroundColor = ConsoleColor.White
    Console.BackgroundColor = ConsoleColor.Black
  End Sub
 
End Class

Следующая часть, она же и основная, содержит несколько функций. Всё начинается с инициализации массива, на котором будет размещена наша карта, а также необходимые ключевые переменные, включая инициализацию объекта, что будет менять цвет клеток.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
  Public _mapTest As Integer(,) = {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
                                  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}
 
  Public _txtRGB As New SystemColorConsole
  Public _pointX, _pointY, _multitool As Integer 'Переменные координат и избранного цвета.
  Public _poiSet, _pointHero As String 'Переменные непрерывного цикла редактора и прожатия клавиш.
  Public _menuVibor(20) As String 'Переменная выбора режимов.

Sub Main. Одна из самых малых частей программы. По сути, все функции идут друг за другом и действуют последовательно в ходе определённых прожатий.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Main()
    _pointHero = 0
    _multitool = 0
    _pointX = 1
    _pointY = 1
 
    While _poiSet <> "0"
      Console.SetCursorPosition(0, 1)
      _txtRGB.WhiteFonfSys()
      Console.WriteLine("          ║Для перемещения используйте клавиши w,a,s,d. Для изменения биома нажмите клавишу e.")
      CraftMap(_pointX, _pointY)     'Функция прорисовывания карты.
      Multicase(_multitool)              'Функция Отображения боковой панели инструментов. В случае выбора той или иной клетки, панель появляется.
      Click_Botton(49, 15)               'Функция прожатия клавиш.
      Console.SetCursorPosition(14, 23)
    End While
    Console.ReadLine()
  End Sub

Функцию Click_Botton сделал опираясь на опыт работы с Ардуино, есть шилды с кнопками для которых писались целые библиотеки управления. И на основе этого опыта получилось такое управление:

Кликните здесь для просмотра всего текста

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
 Public Sub Click_Botton(ByVal _Point_X As Int16, ByVal _point_Y As Integer)
    _txtRGB.BlackFonfSys()
    Dim info As ConsoleKeyInfo = Console.ReadKey()
    Try
      _pointHero = info.Key
      Select Case _pointHero
        'Клавиши передвижения
        Case 87
          If _pointY > 1 Then _pointY -= 1
        Case 65
          If _pointX > 1 Then _pointX -= 1
        Case 83
          If _pointY < _point_Y Then _pointY += 1
        Case 68
          If _pointX < _Point_X Then _pointX += 1
         'Клавиши панели управления
        Case 69
          _menuVibor(1) = 10
          TextunderMap(_pointY, _pointX)
        Case 81
          If _multitool <> 0 Then
            _mapTest(_pointY, _pointX) = _multitool
          End If
        Case 90
          If _multitool <> 0 Then
            _mapTest(_pointY, _pointX) = _multitool
            _mapTest(_pointY + 1, _pointX) = _multitool
            _mapTest(_pointY - 1, _pointX) = _multitool
            _mapTest(_pointY, _pointX + 1) = _multitool
            _mapTest(_pointY, _pointX - 1) = _multitool
            _mapTest(_pointY + 1, _pointX + 1) = _multitool
            _mapTest(_pointY + 1, _pointX - 1) = _multitool
            _mapTest(_pointY - 1, _pointX + 1) = _multitool
            _mapTest(_pointY - 1, _pointX - 1) = _multitool
          End If
        Case 70 'фон
          For i = 0 To 16
            For j = 0 To 50
              _mapTest(i, j) = _multitool
            Next
          Next
        Case 78 'Сохранение
          SaveData()
      End Select
    Catch ex As Exception
 
    End Try
  End Sub

Дальше, CraftMap. Тут должно быть сразу всё понятно из названия, как раз та часть, что производит отрисовку клетки по выбранному элементу массива, с учётом выбранной области.

Кликните здесь для просмотра всего текста

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
 Public Sub CraftMap(ByVal _x As Integer, ByVal _y As Integer)
    Console.Write("              ")
    For i = 0 To 16
      For j = 0 To 50
        If _x = j And _y = i Then
          _txtRGB.TxtRGB("DarkRed", "DarkGray", "█", False)
        Else
          If (i = 0 Or i = 16) Or (j = 0 Or j = 50) Then
            Console.CursorVisible = False
            _txtRGB.TxtRGB("Black", "Cyan", "▓", False)
            Console.BackgroundColor = ConsoleColor.Black
          Else
            Try
              If _mapTest(i, j) = 0 Then Console.Write("░")
              ColorSquear(_mapTest(i, j)) 'Место выбранного элемента массива.
            Catch ex As Exception
              Console.WriteLine("Ошибка построения карты.")
            End Try
          End If
        End If
      Next
      Console.WriteLine("  ")
      Console.Write("              ")
    Next
    Console.WriteLine("  ")
    Console.Write("              ")
  End Sub

Дальше идёт самая муторная часть - меню выбора клеток для панели и цвета этих клеток. В целом, можно добавить сюда ещё разделы и цвета, однако ресурс консоли в этом несколько ограничен.

Кликните здесь для просмотра всего текста

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
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
Public Sub TextunderMap(ByVal _x As Integer, ByVal _y As Integer)
    While _menuVibor(1) <> "5"
      Console.SetCursorPosition(14, 19)
      _txtRGB.WhiteFonfSys()
      Console.WriteLine(" Выберите биом:                                       ")
      Console.WriteLine("           ___________________________________________")
      Console.WriteLine("          ║ 1. Земля        5. Выход                                ")
      Console.WriteLine("          │ 2. Леса                                                 ")
      Console.WriteLine("          │ 3. Реки                                                 ")
      Console.WriteLine("          │ 4. Города                                               ")
      Console.WriteLine("          └                                                         ")
      _txtRGB.BlackFonfSys()
      Dim infom As ConsoleKeyInfo = Console.ReadKey()
      Try
        _menuVibor(1) = infom.Key - 48
        Console.SetCursorPosition(14, 19)
        _txtRGB.WhiteFonfSys()
      Catch ex As Exception
      End Try
      Select Case _menuVibor(1)
        Case 1
          While _menuVibor(2) <> "8"
            Console.WriteLine(" Вы выбрали 'Земля'                                   ")
            Console.WriteLine("           ___________________________________________")
            Console.Write("          ║ 1. Болотная Земля ")
            _txtRGB.TxtRGB("DarkGreen", "DarkGray", "░", False) 'Болотная Земля 1
            Console.Write("   5. Вырубленный лес ") '5
            _txtRGB.TxtRGB("DarkYellow", "Black", "▓", True)
            Console.Write("          │ 2. Камни и горы   ")
            _txtRGB.TxtRGB("DarkGray", "Black", "░", False) '2
            Console.WriteLine("   6. Дороги                              ")
            Console.Write("          │ 3. Низины         ")
            _txtRGB.TxtRGB("DarkGray", "DarkGreen", "▒", False) '3
            Console.WriteLine("   7. Другое                              ")
            Console.Write("          │ 4. Поля           ")
            _txtRGB.TxtRGB("DarkYellow", "DarkGreen", "▓", False) '4
            Console.WriteLine("   8. Выход                               ")
            Console.WriteLine("          └                                           ")
            Dim infom1 As ConsoleKeyInfo = Console.ReadKey()
            Try
              _menuVibor(2) = infom1.Key - 48
              Console.SetCursorPosition(14, 19)
              _txtRGB.WhiteFonfSys()
 
            Catch ex As Exception
            End Try
            Select Case _menuVibor(2)
              Case 1
                _mapTest(_x, _y) = 1
                _multitool = 1
                _menuVibor(2) = "8"
                _menuVibor(1) = "5"
              Case 2
                _mapTest(_x, _y) = 2
                _multitool = 2
                _menuVibor(2) = "8"
                _menuVibor(1) = "5"
              Case 3
                _mapTest(_x, _y) = 3
                _multitool = 3
                _menuVibor(2) = "8"
                _menuVibor(1) = "5"
              Case 4
                _mapTest(_x, _y) = 4
                _multitool = 4
                _menuVibor(2) = "8"
                _menuVibor(1) = "5"
              Case 5
                _mapTest(_x, _y) = 5
                _multitool = 5
                _menuVibor(2) = "8"
                _menuVibor(1) = "5"
              Case 6
                While _menuVibor(6) <> "6"
                  Console.WriteLine(" Вы выбрали 'Дороги'                                  ")
                  Console.WriteLine("           ___________________________________________")
                  Console.Write("          ║ 1. Обычная         ")
                  _txtRGB.TxtRGB("DarkYellow", "DarkGray", "▓", False) 'Дорога 6
                  Console.Write("    5. Дорожный камень     ")
                  _txtRGB.TxtRGB("DarkGreen", "Black", "▓", False) 'Дорога 10
                  Console.WriteLine("                                                                         ")
                  Console.Write("          │ 2. Каменная        ")
                  _txtRGB.TxtRGB("DarkYellow", "Black", "▓", False) 'Дорога 7
                  Console.WriteLine("    6. Выход                                                             ")
                  Console.Write("          │ 3. Затоптанная     ")
                  _txtRGB.TxtRGB("Yellow", "DarkGreen", "░", False) 'Дорога 8
                  Console.WriteLine("                                                                         ")
                  Console.Write("          │ 4. Край дороги     ")
                  _txtRGB.TxtRGB("DarkYellow", "DarkGray", "▒", False)  'Дорога 9
                  Console.WriteLine("                                                                         ")
                  Console.WriteLine("          └                                                              ")
                  Dim infom7 As ConsoleKeyInfo = Console.ReadKey()
                  Try
                    _menuVibor(6) = infom7.Key - 48
                    Console.SetCursorPosition(14, 19)
                    _txtRGB.WhiteFonfSys()
 
                  Catch ex As Exception
                  End Try
                  Select Case _menuVibor(6)
                    Case 1
                      _mapTest(_x, _y) = 6
                      _multitool = 6
                      _menuVibor(6) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 2
                      _mapTest(_x, _y) = 7
                      _multitool = 7
                      _menuVibor(6) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 3
                      _mapTest(_x, _y) = 8
                      _multitool = 8
                      _menuVibor(6) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 4
                      _mapTest(_x, _y) = 9
                      _multitool = 9
                      _menuVibor(6) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 5
                      _mapTest(_x, _y) = 10
                      _multitool = 10
                      _menuVibor(6) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                  End Select
                End While
                _menuVibor(6) = 0
 
              Case 7
                While _menuVibor(7) <> "6"
                  Console.WriteLine(" Вы выбрали 'Прочее'                                  ")
                  Console.WriteLine("           ___________________________________________")
                  Console.Write("          ║ 1. Снег         ")
                  _txtRGB.TxtRGB("White", "DarkGray", "░", False) 'Снег 11
                  Console.Write("   5. Затвердевшая лава  ")
                  _txtRGB.TxtRGB("Red", "Black", "░", False) 'Затвердевшая лава 15
                  Console.WriteLine("                                                                 ")
                  Console.Write("          │ 2. Лёд          ")
                  _txtRGB.TxtRGB("Cyan", "Blue", "▓", False) 'Тонкий лёд 12
                  Console.WriteLine("   6. Выход                      ")
                  Console.Write("          │ 3. Тонкий лёд   ")
                  _txtRGB.TxtRGB("Cyan", "DarkBlue", "▒", False) 'Тонкий лёд 13
                  Console.WriteLine("                                                                 ")
                  Console.Write("          │ 4. Лава         ")
                  _txtRGB.TxtRGB("DarkRed", "DarkYellow", "▓", False) 'Лава 14
                  Console.WriteLine("                                                                 ")
                  Console.WriteLine("          └                                           ")
                  Dim infom8 As ConsoleKeyInfo = Console.ReadKey()
                  Try
                    _menuVibor(7) = infom8.Key - 48
                    Console.SetCursorPosition(14, 19)
                    _txtRGB.WhiteFonfSys()
 
                  Catch ex As Exception
                  End Try
                  Select Case _menuVibor(7)
                    Case 1
                      _mapTest(_x, _y) = 11
                      _multitool = 11
                      _menuVibor(7) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 2
                      _mapTest(_x, _y) = 12
                      _multitool = 12
                      _menuVibor(7) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 3
                      _mapTest(_x, _y) = 13
                      _multitool = 13
                      _menuVibor(7) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 4
                      _mapTest(_x, _y) = 14
                      _multitool = 14
                      _menuVibor(7) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                    Case 5
                      _mapTest(_x, _y) = 15
                      _multitool = 15
                      _menuVibor(7) = "6"
                      _menuVibor(2) = "8"
                      _menuVibor(1) = "5"
                  End Select
                End While
                _menuVibor(7) = "0"
            End Select
 
          End While
          _menuVibor(2) = "0"
        Case 2
          While _menuVibor(3) <> "4"
            Console.WriteLine(" Вы выбрали 'Леса'                                    ")
            Console.WriteLine("           ___________________________________________")
            Console.Write("          ║ 1. Простые       ")
            _txtRGB.TxtRGB("Cyan", "DarkGreen", "░", False) 'Лес 16
            Console.WriteLine("                                                                 ")
            Console.Write("          │ 2. Эльфийские    ")
            _txtRGB.TxtRGB("Black", "DarkGreen", "░", False) 'Эльфийский Лес 17
            Console.WriteLine("                                                               ")
            Console.Write("          │ 3. Заражённые    ")
            _txtRGB.TxtRGB("DarkMagenta", "Black", "░", False) 'Заражённый лес 18
            Console.WriteLine("                                                                  ")
            Console.WriteLine("          │ 4. Выход                                  ")
            Console.WriteLine("          └                                           ")
            Dim infom2 As ConsoleKeyInfo = Console.ReadKey()
            Try
              _menuVibor(3) = infom2.Key - 48
              Console.SetCursorPosition(14, 19)
              _txtRGB.WhiteFonfSys()
 
            Catch ex As Exception
            End Try
            Select Case _menuVibor(3)
              Case 1
                _mapTest(_x, _y) = 16
                _multitool = 16
                _menuVibor(3) = "4"
                _menuVibor(1) = "5"
              Case 2
                _mapTest(_x, _y) = 17
                _multitool = 17
                _menuVibor(3) = "4"
                _menuVibor(1) = "5"
              Case 3
                _mapTest(_x, _y) = 18
                _multitool = 18
                _menuVibor(3) = "4"
                _menuVibor(1) = "5"
            End Select
          End While
          _menuVibor(3) = "0"
        Case 3
          While _menuVibor(4) <> "7"
            Console.WriteLine(" Вы выбрали 'Реки'                                   ")
            Console.WriteLine("           ___________________________________________")
            Console.Write("          ║ 1. Водная местность  ")
            _txtRGB.TxtRGB("Blue", "Black", "░", False) 'Водная местность 19
            Console.Write("     5. Край болота  ")
            _txtRGB.TxtRGB("Black", "DarkGray", "░", True) 'Водная местность 23
            Console.Write("          │ 2. Мелководье        ")
            _txtRGB.TxtRGB("White", "DarkBlue", "░", False) 'Водная местность 20
            Console.Write("     6. Дно болота   ")
            _txtRGB.TxtRGB("DarkGreen", "Black", "░", True) 'Водная местность 24
            Console.Write("          │ 3. Берег             ")
            _txtRGB.TxtRGB("White", "Cyan", "░", False)  'Речная местность 21
            Console.WriteLine("     7. Выход                                 ")
            Console.Write("          │ 4. Болото            ")
            _txtRGB.TxtRGB("DarkGreen", "Black", "▒", True)  'Речная местность 22
            Console.WriteLine("          └                                           ")
            Dim infom3 As ConsoleKeyInfo = Console.ReadKey()
            Try
              _menuVibor(4) = infom3.Key - 48
              Console.SetCursorPosition(14, 19)
              _txtRGB.WhiteFonfSys()
 
            Catch ex As Exception
            End Try
            Select Case _menuVibor(4)
              Case 1
                _mapTest(_x, _y) = 19
                _multitool = 19
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
              Case 2
                _mapTest(_x, _y) = 20
                _multitool = 20
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
              Case 3
                _mapTest(_x, _y) = 21
                _multitool = 21
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
              Case 4
                _mapTest(_x, _y) = 22
                _multitool = 22
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
              Case 5
                _mapTest(_x, _y) = 23
                _multitool = 23
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
              Case 6
                _mapTest(_x, _y) = 24
                _multitool = 24
                _menuVibor(4) = "7"
                _menuVibor(1) = "5"
            End Select
 
          End While
          _menuVibor(4) = "0"
      Case 4
          While _menuVibor(5) <> "7"
            Console.WriteLine(" Вы выбрали 'Города'                                  ")
            Console.WriteLine("           ___________________________________________")
            Console.Write("          ║ 1. Заброшенные  ")
            _txtRGB.TxtRGB("DarkMagenta", "Black", "░", False) '25
            Console.Write("   5. Заброшенные  деревни    ")
            _txtRGB.TxtRGB("DarkRed", "Black", "▓", True) '26
            Console.Write("          │ 2. Действующие  ")
            _txtRGB.TxtRGB("Black", "DarkBlue", "░", False) '28
            Console.Write("   6. Стены укреплений        ")
            _txtRGB.TxtRGB("Black", "DarkMagenta", "▓", True) '27
            Console.Write("          │ 3. Руины        ")
            _txtRGB.TxtRGB("Red", "Black", "░", False) '30
            Console.WriteLine("   7. Выход                                           ")
            Console.Write("          │ 4. Каменный пол ")
            _txtRGB.TxtRGB("Black", "DarkGray", "▒", True) '29
            Console.WriteLine("          └                                           ")
            Dim infom4 As ConsoleKeyInfo = Console.ReadKey()
            Try
              _menuVibor(5) = infom4.Key - 48
              Console.SetCursorPosition(14, 19)
              _txtRGB.WhiteFonfSys()
 
            Catch ex As Exception
            End Try
            Select Case _menuVibor(5)
              Case 1
                _mapTest(_x, _y) = 25
                _multitool = 25
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
              Case 2
                _mapTest(_x, _y) = 28
                _multitool = 28
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
              Case 3
                _mapTest(_x, _y) = 30
                _multitool = 30
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
              Case 4
                _mapTest(_x, _y) = 29
                _multitool = 29
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
              Case 5
                _mapTest(_x, _y) = 26
                _multitool = 26
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
              Case 6
                _mapTest(_x, _y) = 27
                _multitool = 27
                _menuVibor(5) = "7"
                _menuVibor(1) = "5"
            End Select
 
          End While
          _menuVibor(5) = "0"
 
      End Select
    End While
    Console.SetCursorPosition(14, 19)
    _txtRGB.WhiteFonfSys()
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    Console.WriteLine("                                                      ")
    _txtRGB.BlackFonfSys()
  End Sub

Ещё немного осталось. Функция Multicase ничего не делает. Лишь отображает информацию самой панели иснтрументов.

Кликните здесь для просмотра всего текста

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
Public Sub Multicase(ByVal _tool As Integer)
    If _tool <> 0 Then
      Console.SetCursorPosition(67, 2)
      Console.Write("Избранное:")
      Console.SetCursorPosition(67, 3)
      Console.Write("q | ")
      ColorSquear(_tool)
      Console.SetCursorPosition(67, 5)
      Console.Write("Больше:")
      Console.SetCursorPosition(67, 6)
      Console.Write("z | ")
      ColorSquear(_tool)
      ColorSquear(_tool)
      ColorSquear(_tool)
      Console.SetCursorPosition(71, 7)
      ColorSquear(_tool)
      ColorSquear(_tool)
      ColorSquear(_tool)
      Console.SetCursorPosition(71, 8)
      ColorSquear(_tool)
      ColorSquear(_tool)
      ColorSquear(_tool)
      Console.SetCursorPosition(67, 10)
      Console.Write("Фон: f")
      Console.SetCursorPosition(67, 12)
      Console.Write("Сохранить: n")
    End If
  End Sub

ColorSquear - перебирает числовое значение элемента массива под определённый цвет.

Кликните здесь для просмотра всего текста

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
Public Sub ColorSquear(ByVal _toolQ As Integer) '░ ▒ ▓
    If _toolQ = 1 Then _txtRGB.TxtRGB("DarkGreen", "DarkGray", "░", False) 'Болотная Земля 1
    If _toolQ = 2 Then _txtRGB.TxtRGB("DarkGray", "Black", "░", False) 'Камни и горы 2
    If _toolQ = 3 Then _txtRGB.TxtRGB("DarkGray", "DarkGreen", "▓", False) ' Низины 3
    If _toolQ = 4 Then _txtRGB.TxtRGB("DarkYellow", "DarkGreen", "▓", False) ' Поля 4
    If _toolQ = 5 Then _txtRGB.TxtRGB("DarkYellow", "Black", "▓", False) ' Вырубленный лес 5
    '--------------------------------------------------------------------------------
    If _toolQ = 6 Then _txtRGB.TxtRGB("DarkYellow", "DarkGray", "▓", False) 'Дорога обычная 6
    If _toolQ = 7 Then _txtRGB.TxtRGB("DarkYellow", "DarkGray", "▒", False) 'Край дороги 7
    If _toolQ = 8 Then _txtRGB.TxtRGB("DarkGreen", "Black", "▓", False) 'Дорожный камень 8 
    If _toolQ = 9 Then _txtRGB.TxtRGB("DarkYellow", "Black", "▓", False) 'Дорога каменная 9
    If _toolQ = 10 Then _txtRGB.TxtRGB("Yellow", "DarkGreen", "░", False) 'Дорога затоптанная 10
    '--------------------------------------------------------------------------------
    If _toolQ = 11 Then _txtRGB.TxtRGB("White", "DarkGray", "░", False) 'Снег 11
    If _toolQ = 12 Then _txtRGB.TxtRGB("Cyan", "Blue", "▓", False) 'лёд 12
    If _toolQ = 13 Then _txtRGB.TxtRGB("Cyan", "DarkBlue", "▒", False) 'Тонкий лёд 13
    If _toolQ = 14 Then _txtRGB.TxtRGB("DarkRed", "DarkYellow", "▓", False) 'Лава 14
    If _toolQ = 15 Then _txtRGB.TxtRGB("Red", "Black", "░", False) 'Затвердевшая лава 15
    '--------------------------------------------------------------------------------
    If _toolQ = 16 Then _txtRGB.TxtRGB("Cyan", "DarkGreen", "░", False) 'Лес 16
    If _toolQ = 17 Then _txtRGB.TxtRGB("Black", "DarkGreen", "░", False) 'Эльфийский Лес 17
    If _toolQ = 18 Then _txtRGB.TxtRGB("DarkMagenta", "Black", "░", False) 'Заражённый лес 18
    '--------------------------------------------------------------------------------
    If _toolQ = 19 Then _txtRGB.TxtRGB("Blue", "Black", "░", False) 'Водная местность 19
    If _toolQ = 20 Then _txtRGB.TxtRGB("White", "DarkBlue", "▒", False) 'Мелководье 20
    If _toolQ = 21 Then _txtRGB.TxtRGB("White", "Cyan", "░", False)  'Берег 21
    If _toolQ = 22 Then _txtRGB.TxtRGB("DarkGreen", "Black", "▒", False)  'Болото 22
    If _toolQ = 23 Then _txtRGB.TxtRGB("Black", "DarkGray", "░", False) 'Край болота 23
    If _toolQ = 24 Then _txtRGB.TxtRGB("DarkGreen", "Black", "░", False) 'Дно болота 24
    '--------------------------------------------------------------------------------
    If _toolQ = 25 Then _txtRGB.TxtRGB("DarkMagenta", "Black", "░", False) 'Заброшенный город 25
    If _toolQ = 26 Then _txtRGB.TxtRGB("DarkRed", "Black", "▓", False) 'Заброшенная деревня 26
    If _toolQ = 27 Then _txtRGB.TxtRGB("Black", "DarkMagenta", "▓", False) 'Стена башни 27
    If _toolQ = 28 Then _txtRGB.TxtRGB("Black", "DarkBlue", "░", False) 'Действующий город 28
    If _toolQ = 29 Then _txtRGB.TxtRGB("Black", "DarkGray", "▒", False) 'Каменный пол 29
    If _toolQ = 30 Then _txtRGB.TxtRGB("Red", "Black", "░", False) 'Руины 30
  End Sub

И последняя функция, функция сохранения. Сохраняет карту в массив символов, что позволяет полученный массив вставить в код программы и заменить пустой массив в коде на ваш сохранённый файл.

Кликните здесь для просмотра всего текста

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
Public Sub SaveData() ' корректная запись массивов в файл
    Try
      Dim textFileStream As New IO.FileStream("Map.save", IO.FileMode.OpenOrCreate,
                                    IO.FileAccess.ReadWrite, IO.FileShare.None)
      Dim myFileWriter As New IO.StreamWriter(textFileStream)
      Try
        myFileWriter.Write("{")
        For i = 0 To 16
          myFileWriter.Write("{")
          For j = 0 To 50
            myFileWriter.Write(_mapTest(i, j))
            myFileWriter.Write(", ")
          Next
          myFileWriter.Write("},")
          myFileWriter.WriteLine()
        Next
        myFileWriter.WriteLine("}")
      Catch ex As Exception
        Console.WriteLine("Ошибка сохранения данных в блоке записи при сохранении.")
      End Try
      myFileWriter.Close()
      textFileStream.Close()
      Console.WriteLine("Данные сохранены.")
    Catch ex As Exception
      Console.WriteLine("Ошибка сохранения данных в блоке сохранения.")
    End Try
  End Sub

Нажмите на изображение для увеличения
Название: изображение_2023-01-28_133434768.png
Просмотров: 309
Размер: 17.3 Кб
ID: 7900

В целом, это всё. Однако, не хватило сил создать функцию загрузки. Не выходит полноценно перебрать функцию для данной задачи, понимания не хватает как сделать. Ниже представлю полностью рабочий проект.
map.7z

Буду рад получить любые высказывания по данной работе!

Метки code blocks, console application, visual basic

Размещено в Без категории

« Текстовая RPG-игра на С++ Главная страница

Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.

Всего комментариев 2

Комментарии

Старый комментарий

В VB я не разбираюсь, но мне понравилось.

Думаю, было бы классно иметь возможность повернуть персонажа на 90 градусов чтобы строить можно было не только в вертикальном направлении, но ещё и в горизонтальном.

Ну и не знаю насколько это возможно реализовать, но было бы неплохо убрать задержку хода. Т.е., если удерживать условно клавишу A, потом зажать W и отпустить через секунду, то персонаж продолжит движение сначала вправо, а потом вверх, хотя клавишу я уже давно отпустил.

Запись от Myvik_ размещена 28.01.2023 в 16:44 Myvik_ вне форума

Myvik_ вне форума

Старый комментарий

Цитата

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

...чтобы строить можно было не только в вертикальном направлении, но ещё и в горизонтальном.

Так ведь перемещаться и строить можно в любом направлении.

Конечно, в плоском пространстве, естественно.

Запись от DarKing1999 размещена 28.01.2023 в 22:04 DarKing1999 вне форума

DarKing1999 вне форума

DarKing1999 DarKing1999 вне форума

DarKing1999 вне форума

Регистрация 15.12.2016
Адрес Лыткарино
Сообщений 22
Записей в блоге 2

Новые блоги и статьи Все статьи Все блоги /
Был там один разговор по поводу свободы в материальном мире. kumehtar 19.08.2026 Суть: рассматривается живое существо, оказавшееся внутри довольно странной системы (этого мира) и пытающееся обустроить в ней свой кусок пространства. Жизнь действительно предъявляет каждому. . .	Когда логика программы не спасает от человеческих ошибок Maks 18.08.2026 В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .	Лето уходит kumehtar 17.08.2026	Мысли в слух kumehtar 17.08.2026 Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .
Перемещение строк из ТЧ в другой документ с учетом текущего пробега Maks 17.08.2026 Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .	Саморегулирующийся социальный контракт для сервера cross-section. Hrethgir 14.08.2026 С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .	Часы электронные Uhbif79 12.08.2026 Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .	Часы с будильником на основе класса QLCDNumber Uhbif79 12.08.2026 Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .

Наверх