Программа
Doc-filler
Заполнять шаблоны Word из Excel в несколько кликов.
Подробнее...
Заказать макрос
Разрабатываем макросы на заказ. Любой сложности. Быстро и качественно.
Подробнее...

Создание пятнашек в Excel

Это простая всем известная игра цель которой расположить фишки по возрастанию (в первом ряду с 1 по 4, во втором ряду 5-8 и так далее до 15)

Пятнашки в ExcelРазбор создания игры в Excel

При создании игры мы преследовали две цели:

  1. Продемонстрировать возможности программирования и визуализации в Excel. На примере научить вас некоторым приемам создания пользовательской формы и макросов, которые с ней взаимодействуют.
  2. Разнообразить досуг после плодотворной работы в Excel. Игра также встроена в нашу надстройку VBA-Excel чтобы она всегда была под рукой.

Разработка игрового поля

Игровое поле пятнашек состоит по сути из 16 фишек, можно также добавить кнопкой перемешать (начать с начала) и отображением количества шагов. В качестве фишек мы будем использовать обычные кнопки CommandButton - 16 штук. 

Расположим их в виде поля 4x4. Уберем стандартное название кнопок (а свойство Caption) сделаем их квадратными в форме фишек. Вообще тут можно дать волю фантазии наложить тени, выбрать цвет и так далее, углубляться не будем. На игровое поле мы добавили также кнопку перемешать. Она будет служить для сброса и начала новой игры. 

Игровое поле пятнашек

Добавили текстовые поля Label, в которые будем записывать количество потраченных шагов и лучший счет.  Что получилось видно на картинке.

Еще один момент, чтобы кнопки не "нажимались" (т.е., чтобы по клику не происходила анимация нажатия на кнопку), установим свойство Locked в положение True.

Механика игры

Управление перемещением фишек будем реализовывать путем нажатия на стрелки вверх, вниз, влево и вправо. При нажатии на стрелки будем менять текст кнопок (свойство Caption) в зависимости от направления. С анимацией не будем мудрить, сами фишки не будем перемещать, будем просто мгновенно менять текст фишки с одного на другой, визуально будет казаться, что фишка переместилась по полю.

Старт игры

Инициализация формы вызываем процедуру создания поля.

Private Sub UserForm_Initialize()
    Me.Caption = "П Я Т Н А Ш К И"
    Call Peremeshat
End Sub

Случайным образом заполняем игровое поле и проверяем комбинацию на решаемость. Подробно проверку на решаемость описывать не будем, так как не в этом цель. Изучить этот вопрос можно на сайте http://pyatnashki.wmsite.ru/kombinacyi.

Sub Peremeshat()
 
    Dim a&(), i&, Max&
    Dim j As Integer, Num As Integer
    Dim e As Double         'вычисляет номер ряда пустой клетки
    Dim isE As Boolean      'проверка на четность
    Dim mySum As Integer    'сумма количества нужных элементов
 
    'Сбрасываем количество ходов
    stepC = 0
    Me.lbl_stepC.Caption = stepC
 
 
    Randomize ' Включаем генератор случайных чисел
 
NewGame:
    ' Создаем игровое поле
    ReDim a(1 To 16)
    For i = 1 To 16
        Do
            Num = Int(Rnd * 16) + 1
        Loop While IsNumeric(Application.Match(Num, a, 0))
        a(i) = Num
        If a(i) = 16 Then
            Me.Controls("CommandButton" & i).Caption = ""
            Me.Controls("CommandButton" & i).BackColor = &HA0ADBB
        Else
            Me.Controls("CommandButton" & i).Caption = a(i)
            Me.Controls("CommandButton" & i).BackColor = &H8000000F
        End If
    Next
 
    'Проверяем на решаемость
    On Error Resume Next
    mySum = 0
    For i = 1 To 15
        If Me.Controls("CommandButton" & i).Caption = "" Then
            e = (i + 3) / 4
        End If
        For j = i To 15
            If val(Me.Controls("CommandButton" & i).Caption) > val(Me.Controls("CommandButton" & j + 1).Caption) And val(Me.Controls("CommandButton" & j + 1).Caption) > 0 Then
                mySum = mySum + 1
            End If
        Next j
    Next i
    mySum = mySum + Int(e)
    isE = IsEven(mySum)    'проверяем на четность(решаемость)
    If isE = False Then GoTo NewGame    'меняем комбинацию если что
End Sub

Функция проверки заряженного числа на четность

Function IsEven(Num As Integer) As Boolean
    IsEven = Fix(Num / 2) = Num / 2
End Function

Движение фишек

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

Sub ToUp()
    Dim i As Integer
    For i = 12 To 1 Step -1
        If Me.Controls("CommandButton" & i).Caption = "" Then
            ' Меняем значение фишек
            Me.Controls("CommandButton" & i).Caption = Me.Controls("CommandButton" & i + 4).Caption
            Me.Controls("CommandButton" & i + 4).Caption = ""
            ' меняем цвет фишек
            Me.Controls("CommandButton" & i).BackColor = &H8000000F
            Me.Controls("CommandButton" & i + 4).BackColor = &HA0ADBB
            stepC = stepC + 1 ' Увеличиваем количество ходов
            Me.lbl_stepC.Caption = stepC
        End If
    Next i
    Call Proverka
End Sub

В конце делаем проверку поля и проверяем правильно ли игрок расставил фишки.

Sub Proverka()    'Проверка выигрыша
    Dim i As Byte, j As Byte
    For i = 1 To 15
        If val(Me.Controls("CommandButton" & i).Caption) = i Then
            j = j + 1
        End If
    Next i
    If j < 15 Then Exit Sub    ' не выиграли

    Beep
    If MsgBox("Начать новую игру?", vbYesNo, "П О Б Е Д А !") = vbYes Then    'даем варианты
        Call Peremeshat
        Me.lbl_best.ForeColor = &HEFF8FA
    Else
        Unload Me
    End If
End Sub

Осталось "отловить" нажатие стрелок на клавиатуре и запускать нужное движение. Для этого воспользуемся событием формы UserForm_KeyDown.

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode.Value = 40 Then ToDown
    If KeyCode.Value = 38 Then ToUp
    If KeyCode.Value = 37 Then ToLeft
    If KeyCode.Value = 39 Then ToRight
End Sub
Скачать

Рекомендуем к прочтению

Комментарии:

comments powered by Disqus