ИнтеллигенцияX

Пару статей назад была игра "Pacman". А сейчас мы напишем еще одну простенькую игру под названием "Лабиринт", и так же с Pacman'ом в главной роли.
Для особо нетерпеливых сразу выкладываю саму игру и исходники.

Заходите в рубрику - «Игры»

А для особо терпеливых расскажу более подробно.

Создаем форму с размером 290 х 290. На ней располагаем Label (я назвал его StartLabel)  и таймер (YouTime). После этого  наша работа в визуальном редакторе и начинается самое интересное - код.

Импортируем пространство имен:

Imports System.Drawing.Drawing2D

Объявляем несколько переменных:

    Dim Packman As Label 'Объявляем нашего персонажа (Packman)
    Dim DateTimer As DateTime 'Объявляем счетчик времени
    Dim BackGr As New Bitmap(280, 280) 'Здесь мы будем рисовать лабиринт
    Dim AlternativePoint As Point 'Точка, в которой есть как минимум два альтернативных хода

Далее идем в события формы Load и Paint. Прописываем там пару строчек:

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Pack_Init() 'Создаем Packman'а
        Me.BackgroundImage = BackGr 'Отображаем лабиринт на форме
    End Sub

    Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        Lab_Draw() 'Рисуем лабиринт
    End Sub

Для наших Label и Timer события Click и Tick, соответственно:

    Private Sub StartLabel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartLabel.Click
        Packman.Enabled = True 'Оживляем нашего Packman
        DateTimer = DateTime.Now
        YourTime.Start() 'Запускаем счетчик времени
    End Sub

    Private Sub YourTime_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles YourTime.Tick
        'Счетчик
        StartLabel.Text = DateTime.Now.Subtract(DateTimer).Seconds & "." & DateTime.Now.Subtract(DateTimer).Milliseconds
    End Sub

Теперь давайте пропишем парочку собственных процедур, необходимых для работы игры, как Вы уже заметили, это будут Lab_Draw() и Pack_Init():

Private Sub Lab_Draw() 'Рисуем лабиринт
        Dim Graph As Graphics = Graphics.FromImage(BackGr) 'Начинаем рисование
        'Массив точек, которые станут нашим лабиринтом
        Dim Pnts() As Point = New Point() {New Point(10, 10), New Point(190, 10), New Point(190, 30), New Point(70, 30),
                                        New Point(70, 130), New Point(210, 130), New Point(210, 150), New Point(150, 150),
                                        New Point(150, 230), New Point(230, 230), New Point(230, 250), New Point(130, 250),
                                        New Point(130, 150), New Point(30, 150), New Point(30, 130), New Point(50, 130),
                                                                  New Point(50, 30), New Point(10, 30)}
        'Соединяем наши точки
        Dim Types() As Byte = {PathPointType.Start, PathPointType.Line, PathPointType.Line, PathPointType.Line,
                               PathPointType.Line, PathPointType.Line, PathPointType.Line, PathPointType.Line,
                              PathPointType.Line, PathPointType.Line, PathPointType.Line, PathPointType.Line,
                               PathPointType.Line, PathPointType.Line, PathPointType.Line, PathPointType.Line,
                               PathPointType.Line, PathPointType.Line}
        Dim Path As GraphicsPath = New GraphicsPath(Pnts, Types)
        Graph.FillPath(Brushes.Black, Path) 'Закрашиваем получившиеся квадратики
        Graph.DrawImage(BackGr, New Point(0, 0)) 'Переносим всё на Bitmap
        Graph.Dispose() 'Освобождаем ресурсы после рисования
    End Sub

    Private Sub Pack_Init() 'Создаем Packman'а
        Packman = New Label()
        With Packman
            .Height = 20 'Задаем высоту
            .Width = 20 'Задаем ширину
            .Location = New Point(10, 10) 'Стартовое положение
            .BackColor = Color.Gold 'Цвет
            .Enabled = False 'Активность...пока отдыхает
        End With
        AddHandler Packman.Move, AddressOf Pack_GetPosition 'Учим его двигаться
        Me.Controls.Add(Packman) 'Теперь можно его показать
    End Sub

И появилась еще одна процедура Pack_GetPosition, давайте научим его двигаться, точнее проверять свое местоположение:

    Private Sub Pack_GetPosition(ByVal sender As Object, ByVal e As EventArgs) 'Учим его двигаться
        Dim AltP As Byte = 0 'Количество альтернативных вариантов
        Dim CurrentPosition As Point = CType(sender, Label).Location 'Текущее местонахождение
        'Проверяем не является местоположение персонажа финишем
        If CurrentPosition = New Point(210, 230) Then
            YourTime.Stop() 'Останавливаем счетчик
            Packman.Enabled = False 'Отправляем Packman'а на отдых
            MessageBox.Show("Поздравляю! Вы победили!" & vbNewLine & "Ваше время: " & StartLabel.Text)
            StartLabel.Text = "Начать игру"
            DateTimer = Nothing 'Обнуляем счетчик
        End If
        'Считаем количество альтернативных точек
        If (BackGr.GetPixel(Packman.Left + 10, Packman.Top + 21) = Color.FromArgb(255, 0, 0, 0)) Then AltP += 1
        If (BackGr.GetPixel(Packman.Left + 10, Packman.Top - 1) = Color.FromArgb(255, 0, 0, 0)) Then AltP += 1
        If (BackGr.GetPixel(Packman.Left - 1, Packman.Top + 10) = Color.FromArgb(255, 0, 0, 0)) Then AltP += 1
        If (BackGr.GetPixel(Packman.Left + 21, Packman.Top + 10) = Color.FromArgb(255, 0, 0, 0)) Then AltP += 1

        If AltP = 1 Then 'Если только одна альтернативная точка, то...
            Threading.Thread.Sleep(100)
            Packman.Location = AlternativePoint '...откидываем его назад
        Else
            AlternativePoint = CurrentPosition '...всё хорошо, запоминаем текущую позицию как альтернативную точку
        End If
    End Sub

А вот уже теперь, последний кусок кода, в котором мы обрабатываем нажатие клавиш-стрелок и двигаем Pacman'а:

    Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
        If Packman.Enabled = True Then 'Если персонаж активен...
            Dim C As Color
            Select Case e.KeyCode 'Смотрим нажатую клавишу, если...
                Case Keys.Down '...стрелка вниз
                    C = BackGr.GetPixel(Packman.Left + 10, Packman.Top + 21) 'Получаем цвет под персонажем
                    If (C = Color.FromArgb(255, 0, 0, 0)) Then 'Если это черный...
                        Packman.Top += 20 '...то идем вниз
                    End If
                    Return
                Case Keys.Up '...стрелка вверх
                    C = BackGr.GetPixel(Packman.Left + 10, Packman.Top - 1) 'Получаем цвет над персонажем
                    If (C = Color.FromArgb(255, 0, 0, 0)) Then 'Если это черный...
                        Packman.Top -= 20 '...то идем вверх
                    End If
                    Return
                Case Keys.Left '...стрелка влево
                    C = BackGr.GetPixel(Packman.Left - 1, Packman.Top + 10) 'Получаем цвет слева от персонажа
                    If (C = Color.FromArgb(255, 0, 0, 0)) Then 'Если это черный...
                        Packman.Left -= 20 '...то идем влево
                    End If
                    Return
                Case Keys.Right '...стрелка вправо
                    C = BackGr.GetPixel(Packman.Left + 21, Packman.Top + 10) 'Получаем цвет справа от персонажа
                    If (C = Color.FromArgb(255, 0, 0, 0)) Then 'Если это черный...
                        Packman.Left += 20 '...то идем вправо
                    End If
                    Return
            End Select
        End If
    End Sub