{"id":3839,"url":"\/distributions\/3839\/click?bit=1&hash=3488dece0d51c9072d47e529ba178c570b3667a8d0c56d97600bd8e7b7835f37","title":"\u0421\u043c\u043e\u0442\u0440\u0435\u0442\u044c, \u043a\u0430\u043a \u0433\u043e\u0440\u0438\u0442 \u043e\u0433\u043e\u043d\u044c, \u0442\u0435\u0447\u0451\u0442 \u0432\u043e\u0434\u0430, \u0430 \u0440\u043e\u0431\u043e\u0442 \u0441\u043e\u0431\u0438\u0440\u0430\u0435\u0442 \u043a\u043b\u0443\u0431\u043d\u0438\u043a\u0443","buttonText":"\u0425\u043e\u0447\u0443","imageUuid":"6abb4b93-c5c1-5cbc-bb82-b305169ef455","isPaidAndBannersEnabled":false}

Вы устали от навязчивой рекламы, лутбоксов и монетизации в мобильных играх?

Тогда я расскажу вам, как создать игру "3 в 1" на рабочем листе Excel. Бесплатно, без регистрации и СМС.

Предыдущая статья, в которой я рассказал, как сделать простейшие пятнашки с использованием VBA.

Технически получилось у меня не совсем "3 в 1", и дворецкий не станет вымогать у вас звёздочки, чтобы поменять сломанный комод. Игра больше похожа на Toon Blast (есть на обеих мобильных платформах).

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

Создание игрового поля

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

Путем нехитрых проб и ошибок я придумал такое разделение.

1. Лёгкий уровень: 3 вида блоков, средний - 4, сложный - 5.

2. Малое поле: 10х10 клеток, среднее - 14х14 клеток, большое - 18х18.

Переключатели и слайдер необходимо соединить с какими-либо ячейками рабочего стола. В моем случае это "А2" и "А6" соответственно.

Далее в режиме редактирования кода создаем модуль "createModule", инициализируем публичные переменные:

Public rngPlayField As Range, intSize As Byte, intNumSigns As Byte, _ arrSigns() As Variant, arrField() As Variant

Первая отвечает за игровое поле на листе, вторая - за размер поля, третья - за количество типов блоков, четвертая содержит в себе данные для декорирования блоков, пятая - это массив, который дублирует игровое поле (необходим для быстродействия программы).

Я понимаю, что публичные переменные - зло, но в этот раз мы идем простым путем.

Создаем метод:

Sub initializeField() Dim levelNum As Range, sizeNum As Range, i As Byte Set levelNum = Sheets("FIELD").Range("A2") Set sizeNum = Sheets("FIELD").Range("A6") 'определяем уровень сложности (количество типов символов) For i = 1 To 3 If levelNum.Value = i Then intNumSigns = i + 2 End If Next 'определяем размер поля Select Case sizeNum.Value Case 0 intSize = 10 Case 1 intSize = 14 Case 2 intSize = 18 End Select 'заносим в переменную данные о поле Set rngPlayField = _ Sheets("FIELD").Range("D2").Resize(intSize, intSize) 'очищаем предыдущее поле With Sheets("FIELD").Range("D2").Resize(18, 18) .ClearContents .ClearFormats End With Call createField End Sub

Эта программа определяет размер игрового поля и уровень сложности, а потом вызывает метод, который создает это самое поле.

Я решил, что игровые блоки будут декорированы разными символами. Для этого я использовал функцию ChrW(), которая позволяет показать символ Unicode по его индексу. Через цикл я вывел все символы на рабочую страницу Excel и приступил к поиску.

Когда я нашел самые удачные символы, то поместил их на отдельный лист. Ячейки покрасил в цвета, которые подошли больше всего, и написал в новом модуле (stuffModule) небольшую функцию. Она находит цвет ячейки и возвращает его индекс. Эту функцию я использовал на рабочем листе.

Код функции:

Function getIndex(icell As Range) As String getIndex = icell.Interior.Color End Function
​Вид страницы с символами

ОТСТУПЛЕНИЕ

Excel выполняет все действия в массиве быстрее, чем аналогичные действия на рабочем листе. Поэтому использовать массивы в такой игре жизненно необходимо.

Советую использовать параметр Option Base 1, который приводит нижнюю границу массивов к единице. Это немного расходится с общепринятой практикой, но в Excel часто приходится совмещать массивы и диапазоны. Ссылки на диапазоны начинаются с единицы.

Следующая процедура использует массив для формирования игрового поля:

Sub createField() Dim intRndSign As Byte, countFD As Integer, countSD As Integer ReDim arrField(intSize, intSize) arrSigns() = Sheets("DATA").Range("A1:B5").Value 'наполнение массива случайными символами For countFD = 1 To intSize For countSD = 1 To intSize intRndSign = _ Application.WorksheetFunction.RandBetween(1, intNumSigns) arrField(countFD, countSD) = arrSigns(intRndSign, 1) Next Next 'вывод данных массива на экран rngPlayField.Cells = arrField() Call decorateField End Sub

Этот метод инициализирует отдельный массив, который содержит данные символов и их цвет (получены со второго листа).

Далее в зависимости от уровня сложности он наполняет массив игрового поля случайными символами из первого массива и выводит диапазон на экран.

И, наконец, пишем процедуру, которая декорирует игровое поле, используя индекс цвета определенного символа:

Sub decorateField() Dim fndColor As Range, countSigns As Byte, fndBlank As Range 'настройка границ и шрифта With rngPlayField With .Font .size = 22 .Color = vbWhite .Bold = True End With .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter With .Borders .LineStyle = xlContinuous .Weight = xlMedium .Item(xlInsideHorizontal).Color = vbWhite .Item(xlInsideVertical).Color = vbWhite End With End With 'настройка цвета For Each fndColor In rngPlayField.Cells For countSigns = 1 To intNumSigns If fndColor.Value = arrSigns(countSigns, 1) Then fndColor.Interior.Color = arrSigns(countSigns, 2) End If Next Next For Each fndBlank In rngPlayField.Cells If fndBlank.Value = "" Then fndBlank.Interior.Color = vbWhite End If Next End Sub

Примеры того, что получается:

Игровой процесс

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

Для этого в модуле листа, на котором находится игровое поле, пишем следующее (об отдельных, еще не описанных процедурах я расскажу позже):

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.count > 1 Then Exit Sub ElseIf Not Application.Intersect(rngPlayField, Target) _ Is Nothing And Target.Value <> "" Then cellValue = Target.Value Call clearCells(Target) Call countScore Call checkEmpty Call checkColumns Call checkLoose End If End Sub

Создаем модуль "playModule", инициализируем публичную переменную cellValue (int) (для прошлого блока). Создаем новый метод и описываем в нем процедуру нажатия на ячейку:

Sub clearCells(ByVal rngCell As Range) Dim checkCells As Integer, countSigns As Variant For checkCells = -1 To 1 Step 2 'проверка ячеек сверху и снизу If rngCell.Offset(checkCells, 0).Value = cellValue Then With rngCell.Offset(checkCells, 0) .Interior.Color = vbWhite .Value = "" End With Call clearCells(rngCell.Offset(checkCells, 0)) End If 'проверка ячеек слева и справа If rngCell.Offset(0, checkCells).Value = cellValue Then With rngCell.Offset(0, checkCells) .Interior.Color = vbWhite .Value = "" End With Call clearCells(rngCell.Offset(0, checkCells)) End If Next 'Сохранение данных в массив arrField() = rngPlayField End Sub

В данном случае используем рекурсию. Если программа выявила, что не все одинаковые ячейки убраны, она вызывает сама себя.

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

Sub checkEmpty() Dim countFD As Integer, countSD As Integer, countBlank As Integer 'FD - firstDimention, sd - secondDimention For countFD = 2 To intSize For countSD = 1 To intSize 'Если элемент массива пуст и если верхний элемент содержит значение, то они меняются местами If arrField(countFD, countSD) = "" And arrField(countFD - 1, countSD) <> "" Then arrField(countFD, countSD) = arrField(countFD - 1, countSD) arrField(countFD - 1, countSD) = "" countBlank = countBlank + 1 End If Next Next If countBlank > 0 Then Call checkEmpty Else rngPlayField.Cells = arrField() Call decorateField End If End Sub

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

Следующий шаг - смещение блоков влево при наличии пустых колонок:

Sub checkColumns() 'сдвиг колонок влево Dim checkColumn As Byte, countElem As Integer, checkNext As Byte For checkColumn = 1 To intSize 'проверяем, есть ли пустые колонки If Application.WorksheetFunction. _ CountA(rngPlayField.Columns(checkColumn)) = 0 _ And Application.WorksheetFunction. _ CountA(rngPlayField.Columns(checkColumn).Offset(0, 1)) <> 0 Then 'если пустые колонки найдены, то они сдвигаются в массиве For countElem = 1 To intSize arrField(countElem, checkColumn) = _ arrField(countElem, checkColumn + 1) arrField(countElem, checkColumn + 1) = "" checkNext = checkNext + 1 Next End If Next rngPlayField.Cells = arrField() Call decorateField 'запускаем рекурсию для повторной проверки If checkNext > 0 Then Call checkColumns End If End Sub

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

Конец игры

Сперва надо определиться с методом подсчета очков. Я придумал следующее:

Количество очков = (Количество убранных блоков ^ 2) / 2

Создаем две публичные переменные: sumBlank(int) и globScore(long)

В процедуре clearCells() прописываем следующее условие, которое выполняется при удалении одного блока:

sumBlank = sumBlank+1

Создаем метод подсчета очков countScore():

Sub сountScore() Dim currScore As Long currScore = sumBlank * sumBlank / 2 globScore = globScore + currScore Sheets("FIELD").nowScore.Caption = currScore Sheets("FIELD").globalScore.Caption = globScore sumBlank = 0 End Sub

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

Важный момент! Не забывайте в процедуре создания игрового поля initializeField() обнулять переменные и значения лейблов:

Sheets("FIELD").nowScore.Caption = 0 Sheets("FIELD").globalScore.Caption = 0 globScore = 0 sumBlank = 0

Наконец, пишем программу, которая проверяет условия поражения (если отсутствуют ячейки, к которым по горизонтали и вертикали примыкают ячейки с таким же символом) и выводит на экран сообщение с количеством заработанных очков:

Sub checkLoose() 'проверка окончания игры Dim rngFndCells As Range, checkOffset As Integer, countSame As Integer For Each rngFndCells In rngPlayField.Cells For checkOffset = -1 To 1 Step 2 If rngFndCells.Offset(0, checkOffset).Value = _ rngFndCells.Value And rngFndCells <> "" Then countSame = countSame + 1 End If If rngFndCells.Offset(checkOffset, 0).Value = _ rngFndCells.Value And rngFndCells <> "" Then countSame = countSame + 1 End If Next Next If countSame = 0 Then MsgBox "Игра окончена! Очки: " & globScore End If End Sub

Немного скриншотов того, что вышло:

Вот и все. Конечно, создание такой игры заняло больше времени, чем создание пятнашек, но результат вышел неплохим (ХАХАХАХАХА).

Мораль: изучайте более полезные в реальной жизни языки программирования, а VBA оставьте для всяких ненормальных :)

Право запостить картинку с буханкой-троллейбусом оставляю за вами:)

0
94 комментария
Написать комментарий...
Аккаунт удален

Комментарий недоступен

Ответить
Развернуть ветку
Pixel Lens 👹

С подрядчиками и сотрудниками вместо NPC

Ответить
Развернуть ветку
Sergey Ryabenko

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

Ответить
Развернуть ветку
Александр Милашев
Автор

Номинация на коммент дня)

Ответить
Развернуть ветку
5 комментариев
Arseny Zemlin

Ничего непонятно, но очень интересно

Ответить
Развернуть ветку
murgesku

А вот это заявочка на обрушение рынка мобильных игр! Автор бьёт в самое сердце ЦА.

Ответить
Развернуть ветку
Семен Смирнов

Такие приложения писали когда смартфоны еще не стали мейнстримом

Ответить
Развернуть ветку
1 комментарий
The Clever Gamer

Star Citizen как в Excel сделать? «3 в ряд» не мое 🤗

Ответить
Развернуть ветку
Злой Партизан

Уже сделали.  Eve online называется.

Ответить
Развернуть ветку
Сергей Воробьев

You are welcome!
http://garycki.com/pandora.html
Игру настоятельно рекомендую.

Ответить
Развернуть ветку
10 комментариев
Психический микрофон

Можно теперь какие-нибудь нормальные мобильные игры? Ассасин там или Принц Персии.

Ответить
Развернуть ветку
Александр Милашев
Автор

Принца не обещаю, но рогалик какой-нибудь запилить можно)

Ответить
Развернуть ветку
30 комментариев
Илья Щибрик
как создать игру «3-в-1»

Я так полагаю, вы имели в виду «три-в-ряд».

Ответить
Развернуть ветку
Александр Милашев
Автор

Именно) немного попутал

Ответить
Развернуть ветку
Надежный ключ

Когда-то, когда телевизоры были тяжёлыми, такие игры в них были :)

Ответить
Развернуть ветку
Аккаунт удален

Комментарий недоступен

Ответить
Развернуть ветку
Александр Милашев
Автор

Не слишком лагает?

Ответить
Развернуть ветку
1 комментарий
Аккаунт удален

Комментарий недоступен

Ответить
Развернуть ветку
Влад Морозов

Блин, легче уж рекламку посмотреть 😂

Ответить
Развернуть ветку
Evgeny Loychenko
на обеих мобильных платформах

There is only two gender 😏

Ответить
Развернуть ветку
Король Ночи

После этой статьи многие читатели решат, что именно так легко и просто делаются и настоящие большие игры три-в-ряд

Ответить
Развернуть ветку
Николай Батычко

Не сильно сложнее, если не учитывать код рекламы, магазина и всякие удерживатели в игре.

Ответить
Развернуть ветку
13 комментариев
Вадим Краснобородько
настоящие большие игры
три-в-ряд

Ахахахахахаха)
Продолжай :3

Ответить
Развернуть ветку
4 комментария
Frog

Ну да, легкотня. Тут у вас какие-то странные надписи на эльфийском языке, разными цветами. Циферки какие-то, нолики и единички. Как из этого может получиться игра?))

Ответить
Развернуть ветку
doctor death
Ответить
Развернуть ветку
Sergey Se

Что за фильм был? Очень знакомо

Ответить
Развернуть ветку
1 комментарий
Король Ночи

полученная игра не соответствует заявленному скриншоту, бан!

Ответить
Развернуть ветку
Олег Хельгар

ладно

Ответить
Развернуть ветку
Apollo14

Это как строить корабли из спичек внутри пустых стеклянных бутылок. Люмпенизм какой-то :)

Ответить
Развернуть ветку
Читать все 94 комментария
null