Курсовая работа. Игра «Змейка» Реализация и исходный код программы
Ниже представлен исходный код программы, каждая процедура описана. Это позволяет легко понять принцип работы программы.
Option Explicit
'Функция получения состояния клавиши
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'Функция создания hdc на основе другого. Позволяет выделить зону в памяти
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
'Функция создания зоны в созданом hdc. Позволяет выделить зону для рисования в созданом hdc. Эта зона позволяет что либо нарисовать в HDC. В функции присутствую параметры размера рисунка.
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
'Функция объединения созданного hdc и зоны зарисовки в нём.
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
'Функция удаления контекста устройства. Каждое созданное устройство нужно удалять после завершения работы.
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Функция удаления созданной области рисования в hdc.
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Функция заполнения повторяющимся рисунком определенной зоны. Здесь используется, чтобы очищать созданый hdc, после рисования в нее. Т.е идет заполнение черным цветом.
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
'Функция копирования изображения из одного hdc в другое. Здесь используется для копирования изображения из созданного hdc на форму.
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Функция создания пера вывода. Здесь используется для настройки вывода через функцию FillRect.
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
'Функция Заполнения прямоугольника на основе Rect
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
'Функция определения времени на данный момент. Возвращаемое значение - long. Здесь используется для регулировки скорости рисования змейки.
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
'Прямоугольная область, задаётся координатами. Здесь используется для передачи данных размера квадратов змейки и приза.
Private Type RECT
Left As Long
top As Long
Right As Long
Bottom As Long
End Type
'Переменная хранаящая созданый hdc.
Dim DC As Long
'Переменная принимающая информацию о создаваемой зоне рисунка в DC
Dim BUFFER_DC As Long
'Параметры вывода получаемые. Задаются через CreatePen.
Dim DRAW_PARAM As Long
'Элемент змейки задается как тип переменная, содержащая X и Y координаты элемента.
Private Type ЧАСТЬ_ЗМЕИ
X As Integer
Y As Integer
End Type
'Направление движения змейки. Может принимать 4 значения. Влево - 0, вверх - 1, вправо - 2, вниз - 3.
Dim НАПРАВЛЕНИЕ_ЗМЕИ As Integer
'Создаем массив из куков змейки.
Dim ЗМЕЯ(50) As ЧАСТЬ_ЗМЕИ
'Длинна змейки.
Dim ДЛИНА_ЗМЕИ As Integer
'Тип переменной - приз
Private Type ПРИЗ
X As Integer
Y As Integer
'Переменная состояния. Как только False - приз устанавливается в новое место
ПЕРЕСТАНОВКА As Boolean
End Type
Dim ПРИЗ As ПРИЗ
'Тип переменной - ловушка
Private Type ЛОВУШКА
X As Integer
Y As Integer
'Переменная состояния. Как только False - приз устанавливается в новое место
ПЕРЕСТАНОВКА As Boolean
End Type
Dim ЛОВУШКА As ЛОВУШКА
'Т.к форма квадратная, то переменная храниит размеры высоты и ширины формы.
Dim РАЗМЕР_ФОРМЫ As Integer
'Размер блока для рисования.
Dim РАЗМЕР_БЛОКА As Integer
'Блок рисования змейки.
Dim БЛОК As RECT
'Переменная использующаяся для перебора элементов в цикле FOR NEXT
Dim K As Integer
'Переменные, использующиеся для вывода сообщений о ходе игры на экран
Dim Prompt As String
Dim Title As String
Dim Сообщение
'Добавляем кнопку для получения сведений об игре
Private Sub Command3_Click()
'Выдаём сообщение об игре
MsgBox "Цель игры - удержать змею в пределах игрового поля и от пересечения собственного тела. Время от времени на случайном месте поля появляются некоторые изображения - призы(зелёного цвета) и ловушки(красного цвета). Змея голодна и не прочь подкрепиться призами, если змея съест приз, то её тело вырастает на одну секцию. Ловушки же змея должна избегать - если змея попадает в ловушку, то её тело уменьшается на одну секцию. Если змея ударилась о границу поля, пересекла собственное тело или длина её тела стала равной нулю, игра считается проигранной. Управление змейкой осуществляется кнопками - стрелками. Игрок может изменять уровень сложности игры, выбрав соответствующий переключатель." & Chr(13) & "РАЗРАБОТЧИК ПРОГРАММЫ - СТУДЕНТ ИС-Р31 КУЛИЧЕНКО СЕРГЕЙ" & Chr(13) & "ЮРГУЭС 2004"
End Sub
Private Sub Form_Activate()
'Настройка всех параметров
НАСТРОЙКА_ПАРАМЕТРОВ
End Sub
Sub НАСТРОЙКА_ПАРАМЕТРОВ()
'Стартовая длина змейки
ДЛИНА_ЗМЕИ = 3
'Задаем размер формы.
РАЗМЕР_ФОРМЫ = 300
'Задаем размер квадрата вывода.
РАЗМЕР_БЛОКА = 10
'Создаём hdc в памяти.
DC = CreateCompatibleDC(Me.hdc)
'Выделяем в нём зону для рисования
BUFFER_DC = CreateCompatibleBitmap(Me.hdc, РАЗМЕР_ФОРМЫ, РАЗМЕР_ФОРМЫ)
'Объединяем DC и BUFFER_DC
SelectObject DC, BUFFER_DC
'Удалаяем использованный BUFFER_DC
DeleteObject BUFFER_DC
'Установим змейку
УСТАНОВКА_ЗМЕИ
End Sub
'Запуск игры
Private Sub Command1_Click()
'Делаем неактивным переключатель 1
Option1.Enabled = False
'Делаем неактивным переключатель 2
Option2.Enabled = False
'Делаем неактивным переключатель 3
Option3.Enabled = False
'Делаем неактивным переключатель 4
Option4.Enabled = False
'Делаем неактивной кнопку
Command1.Enabled = False
Command3.Enabled = False
'Вводим переменную для регулирования скорости движения в зависимости от выбранного переключателя
Dim T As Integer
'Выбираем уровень сложности
'Если выбран переключатель 1, то задаём значение Т = 150
If Option1 Then T = 150 Else
'Если выбран переключатель 2, то задаём значение Т = 90
If Option2 Then T = 90 Else
'Если выбран переключатель 3, то задаём значение Т = 50
If Option3 Then T = 50 Else
'Если выбран переключатель 4, то задаём значение Т = 20
If Option4 Then T = 20
'Переменная получения текущего времени
Static ТАЙМ As Long
ТАЙМ = GetCurrentTime
Do
'Сравниваем, если прошло Т милисекунд, то выполняем.
If GetCurrentTime - ТАЙМ > T Then
'Очищаем
Call PatBlt(DC, 0, 0, РАЗМЕР_ФОРМЫ, РАЗМЕР_ФОРМЫ, &H42)
'Рисуем в DC змейку
РИСОВАНИЕ_ЗМЕИ
'Рисуем в DC приз
РИСОВАНИЕ_ПРИЗА
'Рисуем ловушку
РИСОВАНИЕ_ЛОВУШКИ
'Выводим полученную картинку на форму.
Call BitBlt(Me.hdc, 0, 0, РАЗМЕР_ФОРМЫ, РАЗМЕР_ФОРМЫ, DC, 0, 0, &HCC0020)
'Снова получаем время
ТАЙМ = GetCurrentTime
End If
DoEvents
Loop
End Sub
'Установка элементов змейки
Sub УСТАНОВКА_ЗМЕИ()
' Устанавливаем нулевой элемент змейки в середину формы по X
ЗМЕЯ(0).X = РАЗМЕР_ФОРМЫ / 2
' Устанавливаем нулевой элемент змейки в середину формы по X
ЗМЕЯ(0).Y = РАЗМЕР_ФОРМЫ / 2
For K = 0 To ДЛИНА_ЗМЕИ - 1
' Перебирая каждый элемент змейки устанавливаем его в след предидущего.
ЗМЕЯ(K + 1).X = ЗМЕЯ(K).X
ЗМЕЯ(K + 1).Y = ЗМЕЯ(K).Y
Next
End Sub
' Рисование змейки
Sub РИСОВАНИЕ_ЗМЕИ()
'Создается кисть для FillRect, с цветом вывода &HFF00&
DRAW_PARAM = CreatePen(0, 3, &HFFFF&)
'Проверка нажатия клавиш + проверка на движение в противопорложную сторону.
If GetAsyncKeyState(37) Then If НАПРАВЛЕНИЕ_ЗМЕИ <> 2 Then НАПРАВЛЕНИЕ_ЗМЕИ = 0
If GetAsyncKeyState(39) Then If НАПРАВЛЕНИЕ_ЗМЕИ <> 0 Then НАПРАВЛЕНИЕ_ЗМЕИ = 2
If GetAsyncKeyState(38) Then If НАПРАВЛЕНИЕ_ЗМЕИ <> 3 Then НАПРАВЛЕНИЕ_ЗМЕИ = 1
If GetAsyncKeyState(40) Then If НАПРАВЛЕНИЕ_ЗМЕИ <> 1 Then НАПРАВЛЕНИЕ_ЗМЕИ = 3
'Если длинна змейки - размер массива, то устанавливаем длинну змейки в размер массива.
If ДЛИНА_ЗМЕИ > UBound(ЗМЕЯ) Then ДЛИНА_ЗМЕИ = UBound(ЗМЕЯ)
'Выбор вычитания координат в соответствии с НАПРАВЛЕНИЕ_ЗМЕИ
Select Case НАПРАВЛЕНИЕ_ЗМЕИ
Case 0
ЗМЕЯ(0).X = ЗМЕЯ(0).X - РАЗМЕР_БЛОКА
Case 1
ЗМЕЯ(0).Y = ЗМЕЯ(0).Y - РАЗМЕР_БЛОКА
Case 2
ЗМЕЯ(0).X = ЗМЕЯ(0).X + РАЗМЕР_БЛОКА
Case 3
ЗМЕЯ(0).Y = ЗМЕЯ(0).Y + РАЗМЕР_БЛОКА
End Select
'Перебор всех елементов массива, начиная с последнего к первому.
For K = ДЛИНА_ЗМЕИ To 1 Step -1
'Проверка удара нулевого элемента змейки об остальные.
If ЗМЕЯ(0).X = ЗМЕЯ(K).X And ЗМЕЯ(0).Y = ЗМЕЯ(K).Y Then
'Генерируем сообщение
ПЕРЕСЕКЛА_ТЕЛО
Exit Sub
End If
'Здесь каждый следующий после нулевого, элемент змейки устанавливается на старое место предидущего.
ЗМЕЯ(K).X = ЗМЕЯ(K - 1).X
ЗМЕЯ(K).Y = ЗМЕЯ(K - 1).Y
'Вывод блоков. Т.е в цикле перебираются все елементы и каждый выводит себя в DC
Call DRAW_BLOCK(ЗМЕЯ(K).X, ЗМЕЯ(K).Y)
Next
'Проверка на уход змейки за границы экрана.
If ЗМЕЯ(0).X < 0 Then ВЫХОД_ЗА_КРАЙ
If ЗМЕЯ(0).Y < 0 Then ВЫХОД_ЗА_КРАЙ
If ЗМЕЯ(0).X = РАЗМЕР_ФОРМЫ Then ВЫХОД_ЗА_КРАЙ
If ЗМЕЯ(0).Y = РАЗМЕР_ФОРМЫ Then ВЫХОД_ЗА_КРАЙ
End Sub
'Рисование приза.
Sub РИСОВАНИЕ_ПРИЗА()
'Создается кисть для FillRect, с цветом вывода &HFF00&
DRAW_PARAM = CreatePen(0, 3, &HFF00&)
'Проверка на попадание змейки на приз
If ЗМЕЯ(0).X = ПРИЗ.X And ЗМЕЯ(0).Y = ПРИЗ.Y Then
'Змейка удлиняется
Call УДЛИНЕНИЕ_ЗМЕИ(1)
'Приз перемещается в новую зону
ПРИЗ.ПЕРЕСТАНОВКА = False
End If
If ПРИЗ.ПЕРЕСТАНОВКА = False Then
'Приз устанавливается в зону на экране. Установка производится с шагом в РАЗМЕР_БЛОКА.
'Это позволяет змее точно попасть на приз
ПРИЗ.X = Int(Rnd * РАЗМЕР_ФОРМЫ / РАЗМЕР_БЛОКА) * РАЗМЕР_БЛОКА
ПРИЗ.Y = Int(Rnd * РАЗМЕР_ФОРМЫ / РАЗМЕР_БЛОКА) * РАЗМЕР_БЛОКА
'Установка произведена и переменная принимает значение true до следующего попадания змейки в приз
ПРИЗ.ПЕРЕСТАНОВКА = True
End If
'Вызов рисования блока приза
Call DRAW_BLOCK(ПРИЗ.X, ПРИЗ.Y)
End Sub
Sub РИСОВАНИЕ_ЛОВУШКИ()
'Создается кисть для FillRect, с цветом вывода &HFF
DRAW_PARAM = CreatePen(0, 3, &HFF)
If ЗМЕЯ(0).X = ЛОВУШКА.X And ЗМЕЯ(0).Y = ЛОВУШКА.Y Then
'При попадании на ловушку, змея укорачивается на один сегмент.
Call УКОРАЧИВАНИЕ_ЗМЕИ(1)
'Происходит престановка ловушки на новое место
ЛОВУШКА.ПЕРЕСТАНОВКА = False
End If
'ЛОВУШКА устанавливается в зону на экране. С шагом в РАЗМЕР_БЛОКА.
If ЛОВУШКА.ПЕРЕСТАНОВКА = False Then
ЛОВУШКА.X = Int(Rnd * РАЗМЕР_ФОРМЫ / РАЗМЕР_БЛОКА) * РАЗМЕР_БЛОКА
ЛОВУШКА.Y = Int(Rnd * РАЗМЕР_ФОРМЫ / РАЗМЕР_БЛОКА) * РАЗМЕР_БЛОКА
ЛОВУШКА.ПЕРЕСТАНОВКА = True
End If
Call DRAW_BLOCK(ЛОВУШКА.X, ЛОВУШКА.Y)
End Sub
Sub УДЛИНЕНИЕ_ЗМЕИ(N As Integer)
'Устанавливаем элементы змейки, начиная с последнего
For K = ДЛИНА_ЗМЕИ To ДЛИНА_ЗМЕИ + N
ЗМЕЯ(K + 1).X = ЗМЕЯ(K).X
ЗМЕЯ(K + 1).Y = ЗМЕЯ(K).Y
Next
'Увеличиваем змейку на N звеньев
ДЛИНА_ЗМЕИ = ДЛИНА_ЗМЕИ + N
'Проверяем, не стала ли длина змеи больше 50 элементов
If ДЛИНА_ЗМЕИ = 20 Then
'Генерируем сообщение
ПОБЕДА
End If
End Sub
Sub УКОРАЧИВАНИЕ_ЗМЕИ(N As Integer)
'Уменьшаем длину тела змеи
ДЛИНА_ЗМЕИ = ДЛИНА_ЗМЕИ - N
'Проверяем, если длина змеи = 0, то выдаём сообщение
If ДЛИНА_ЗМЕИ = 0 Then
'Генерируем сообщение
УНИЧТОЖЕНИЕ
End If
End Sub
'Рисование блока
Private Function DRAW_BLOCK(X As Integer, Y As Integer)
'Установка координат блока
БЛОК.Left = X + 1
БЛОК.top = Y + 1
БЛОК.Right = X + РАЗМЕР_БЛОКА - 1
БЛОК.Bottom = Y + РАЗМЕР_БЛОКА - 1
'Рисование блока
Call FillRect(DC, БЛОК, DRAW_PARAM)
End Function
Sub ПОБЕДА()
'Выдаём сообщение об окончании игры
Prompt = "ВЫ ПОБЕДИЛИ" & Chr(13) & "ВЫ НАБРАЛИ " & ДЛИНА_ЗМЕИ * 100 & " ОЧКОВ"
Prompt = Prompt & Chr(13) & Chr(10)
Prompt = Prompt & "НАЧАТЬ ИГРУ ЗАНОВО?"
Title = "ЗМЕЙКА"
Сообщение = MsgBox(Prompt, vbYesNo, Title)
If Сообщение = vbNo Then
End
Else
If Сообщение = vbYes Then НАСТРОЙКА_ПАРАМЕТРОВ
End If
'Останавливаем работу программы
End
End Sub
Sub ВЫХОД_ЗА_КРАЙ()
'Выдаём сообщение об окончании игры
Prompt = "ВАША ЗМЕЙКА РАЗБИЛАСЬ" & Chr(13) & "ВЫ НАБРАЛИ " & ДЛИНА_ЗМЕИ * 100 & " ОЧКОВ"
Prompt = Prompt & Chr(13) & Chr(10)
Prompt = Prompt & "НАЧАТЬ ИГРУ ЗАНОВО?"
Title = "GAME OWER"
Сообщение = MsgBox(Prompt, vbYesNo, Title)
If Сообщение = vbNo Then
End
Else
If Сообщение = vbYes Then НАСТРОЙКА_ПАРАМЕТРОВ
End If
End Sub
Sub ПЕРЕСЕКЛА_ТЕЛО()
'Выдаём сообщение об окончании игры
Prompt = "ВАША ЗМЕЙКА УКУСИЛА СЕБЯ" & Chr(13) & "ВЫ НАБРАЛИ " & ДЛИНА_ЗМЕИ * 100 & " ОЧКОВ"
Prompt = Prompt & Chr(13) & Chr(10)
Prompt = Prompt & "НАЧАТЬ ИГРУ ЗАНОВО?"
Title = "GAME OWER"
Сообщение = MsgBox(Prompt, vbYesNo, Title)
If Сообщение = vbNo Then
End
Else
If Сообщение = vbYes Then НАСТРОЙКА_ПАРАМЕТРОВ
End If
'Останавливаем работу программы
' End
End Sub
Sub УНИЧТОЖЕНИЕ()
'Выдаём сообщение об окончании игры
Prompt = "ДЛИНА ВАШЕЙ ЗМЕЙКИ = 0" & Chr(13) & "ВЫ НАБРАЛИ " & ДЛИНА_ЗМЕИ * 100 & " ОЧКОВ"
Prompt = Prompt & Chr(13) & Chr(10)
Prompt = Prompt & "НАЧАТЬ ИГРУ ЗАНОВО?"
Title = "GAME OWER"
Сообщение = MsgBox(Prompt, vbYesNo, Title)
If Сообщение = vbNo Then
End
Else
If Сообщение = vbYes Then НАСТРОЙКА_ПАРАМЕТРОВ
End If
End Sub
Private Sub Command2_Click()
'Заканчиваем работу программы
End
End Sub
