VB.net - Пары слов (mindgames)
В этой статье я расскажу еще об одной программе, для тренировки памяти, а так же о том как ее сделать. Для этого мы будем использовать функцию поиска в массиве.
На форму помещаем следующие элементы:
- ярлык - в нем будет выводится подсказка к действию.
- ярлык для вывода пройденного времени
- кнопка, для новой раскладки
- кнопка для перемешивания.
- таймер
а так же файл содержащий некоторое количество слов, в данной программе их должно быть не меньше 20.
А теперь переходим к коду
Так как мы будем работать с внешним файлом, то подключаем библиотеку ввода вывода.
Imports System.IO 'подключаем библиотеку Ввода-Вывода
В самом начале объявляем необходимые переменные.
Dim lblN() As Label 'массив ярлыков
Dim full As Byte ' размер массива ярлыков
'элементы для ярлыка
'размеры
Dim Wir As Byte = 250
Dim Dlin As Byte = 45
Dim kolvoPar = 10 'колво пар слов
Dim startPosL As Byte = 60 'начальное положение 1 ярлыка по X
Dim startPosH As Byte = 80 'начальное положение 1 ярлыка по Y
'интервалы
Dim intervalH = 5
Dim intervalW = 25
'Ориг массивы
Dim massOrig1(kolvoPar - 1)
Dim massOrig2(kolvoPar - 1)
'Перемеш массивы
Dim massMix1(kolvoPar - 1)
Dim massMix2(kolvoPar - 1)
Dim Index1 'индекс слова из 1 колонки в ОРИГ массиве
Dim Index2 'индекс слова из 1 колонки в перемеш массиве
Dim texts2 'слово ответ во 2 колонке
Dim texts2v 'слово, на выбранном ярлыке из 2 колонки
Dim OdinDva = False 'если ЛОЖЬ, первое нажатие, ИСТИНА - 2 нажатие
Dim zapomni = False 'если ЛОЖЬ, нажатия не регистрируются
Dim kolvo = 0 'количество угаданных пар
Dim ti = 0 'время
Подпрограммы.
Строим таблицу.
Создается стандартным образом.
20 ярлыков - 2 колонки по 10 строк.
'строим таблицу - загрузка
Sub postroenieTabl()
' razmer = Val(frmTablNastr.num.Value)
full = kolvoPar * 2 - 1 'full - размер массива
'меняем размер массива
ReDim lblN(full)
'располагаем наши ярлыки на форме и задаем им числа
For i = 0 To full 'от 0 до последнего элемента
lblN(i) = New Label 'каждый элемент массива - новый ярлык
'размеры
lblN(i).Height = Dlin
lblN(i).Width = Wir
'положение на форме
If i < kolvoPar Then
lblN(i).Left = startPosL
lblN(i).Top = startPosH + i * (intervalH + Dlin)
Else
lblN(i).Left = startPosL + intervalW + Wir
lblN(i).Top = startPosH + (i - kolvoPar) * (intervalH + Dlin)
End If
lblN(i).TextAlign = ContentAlignment.MiddleCenter 'выравниваем текст по центру
lblN(i).Font = New System.Drawing.Font("Arial", 18) 'задаем шрифт
lblN(i).BackColor = Color.LightGray 'задаем фон
lblN(i).Visible = True 'делаем видимыми
Me.Controls.Add(lblN(i)) 'добавляем на форму
'кликаем - получаем индекс элемента
AddHandler lblN(i).Click, AddressOf lblNClick
Me.Controls.AddRange(Me.lblN)
'ЭНД --- кликаем - получаем индекс обработка этого события дальше
Next
End Sub
Подпрограмма bykovki() - для обнуления переменных и вывода в ярлыки слов.
Для вывода нового набора слов, добавляем в массив файл со словами.
в массивы, ориг и перемешиваемый, добавляем случайные слова.
Затем выводим эти слова.
' располагаем буквы на таблице- новый набор
Sub bykovki()
'обнуление
ti = 0
Timer1.Enabled = True
zapomni = False
Button2.Enabled = True
kolvo = 0
OdinDva = False
Label1.Text = "Запомни пары слов"
'новая раскладка
Randomize()
Dim syw() = IO.File.ReadAllLines("bin/ana/syw.txt", System.Text.Encoding.Default)
For i = 0 To kolvoPar - 1
Dim ak = Rnd() * syw.Length
Dim bk = Rnd() * syw.Length
massOrig1(i) = syw(ak)
massMix1(i) = syw(ak)
massOrig2(i) = syw(bk)
massMix2(i) = syw(bk)
Next
For j = 0 To kolvoPar * 2 - 1
If j < kolvoPar Then
lblN(j).Text = massMix1(j)
Else
lblN(j).Text = massMix2(j - kolvoPar)
End If
lblN(j).ForeColor = Color.Black
lblN(j).Enabled = True
Next
End Sub
Перемешивание.
Регистрируем выполнение подпрограммы перемешивания.
Так как эта программа часть большой программы, то некоторые, часто используемые функции и процедуры, я поместил в модуль.
'перемешивание слов
Sub megaMix()
zapomni = True
Mod1.mixx(massMix1)
Mod1.mixx(massMix2)
For j = 0 To kolvoPar * 2 - 1
If j < kolvoPar Then
lblN(j).Text = massMix1(j)
Else
lblN(j).Text = massMix2(j - kolvoPar)
End If
Next
Label1.Text = "Найди пары слов"
End Sub
mod1.mixx()
После перемешивания значений в массивах, выводим те же слова, но в другом порядке.
Добавляем обработчик нажатий для созданных ярлыков.
По сути, в него и помещается главный код.
'кликаем - получаем индекс
Private Sub lblNClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim i As Integer
'Если надо узнать именно индекс в массиве,
'то ищем объект sender
i = Array.IndexOf(lblN, sender)
'-------------
'если запоминаем, то кликать бессмысленно!
If zapomni Then
If i < kolvoPar Then
If OdinDva = False Then
'1 нажатие на 1 столб
lblN(i).ForeColor = Color.Red
Index2 = i
'! поиск в массиве(massOrig1)
'индекса данного слова (lblN(i).Text)
Index1 = (Array.IndexOf(massOrig1, lblN(i).Text))
texts2 = massOrig2(Index1)
OdinDva = True
End If
Else
'2 нажатие на 2 столб
If OdinDva = True Then
texts2v = lblN(i).Text
'если отв прав
If texts2v = texts2 Then
' MsgBox(texts1 & " " & texts2)
lblN(i).Text = ""
lblN(Index2).Text = ""
lblN(i).Enabled = False
lblN(Index2).Enabled = False
kolvo += 1
'если угадали все
'выводится диалог - заново или выход
If kolvo = kolvoPar Then
Timer1.Enabled = False
Dim MessageB As DialogResult = MessageBox.Show("Вы справились за" + Str(ti) + " сек. Повторить?", _
"Победа", MessageBoxButtons.YesNo, _
MessageBoxIcon.Information)
If MessageB = DialogResult.No Then Me.Close()
If MessageB = DialogResult.Yes Then bykovki()
End If
Else
'если отв НЕ прав
lblN(Index2).ForeColor = Color.Black
ti += 5
lblTimer.Text = ti
lblTimer.ForeColor = Color.Red
End If
Else
'1 нажатие на 2 столб
MsgBox("Сначала выбери слово из первой колонки", MsgBoxStyle.Information, "Пары слов")
End If
OdinDva = False
End If
Else
Dim MessageB As DialogResult = MessageBox.Show("Для продолжения необходимо перемешать." + _
vbCrLf + "Продолжить?", "Пары слов", _
MessageBoxButtons.YesNo, MessageBoxIcon.Information)
'If MessageB = DialogResult.No Then MessageB.Cancel()
If MessageB = DialogResult.Yes Then
megaMix()
Button2.Enabled = False
End If
End If
End Sub
После процедур, добавляем их в нужные элементы.
При загрузке строим таблицу и выводим слова для запоминания.
Private Sub frmMemory_Load(sender As Object, e As EventArgs) Handles MyBase.Load
postroenieTabl()
bykovki()
End Sub
В первую кнопку - новый расклад - вывод новых пар слов.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
bykovki()
End Sub
Во вторую кнопку - перемешивание массива.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
megaMix()
Button2.Enabled = False
End Sub
В таймер - отсчет времени и вывод его в ярлык.
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ti += 1
lblTimer.ForeColor = Color.Gray
lblTimer.Text = ti
End Sub
ПРОВЕРЯЕМ.
При запуске создается таблица ярлыков, заполненная случайными словами.
При клики на них появляется информация.
Нажимаем НЕТ - сообщение закрывается.
Нажимаем ДА - слова перемешиваются, кнопка ПЕРЕМЕШАТЬ становится неактивной.
Кликаем по 2 колонке - сообщение.
Выбираем любое слово из 1 колонке - оно краснеет, затем выбираем слово из 2 колонки.
если это правильная пара - они исчезнут, иначе слово в 1 колонке станет снова черным.
Цель тренировки - за наименьшее время найти все пары слов.
По нахождению всех пар появится сообщение - время выполнения.
Данная программа будет включена в очередной выпуск Программы для развития мозга.
На сегодня это все.
До новых встреч!
Смотреть видео
В начало
| 
