Читать книгу «Справочник Жаркова по проектированию и программированию искусственного интеллекта. Том 6: Программирование на Visual Basic искусственного интеллекта. Продолжение 2» онлайн полностью📖 — Валерия Алексеевича Жаркова — MyBook.





picBallPre1.Image = Nothing

For i As Integer = 0 To 80

MPBoxes(i).Reset()

Next

End Sub

Private Sub DrawBoard(ByVal sender As Object, _

ByVal e As System.Windows.Forms.PaintEventArgs) _

Handles MyBase.Paint

Dim g As Graphics = e.Graphics

'Рисуем сетку линиями красного (Red) цвета:

Dim p1 As New Pen(Color.Red)

Dim p2 As New Pen(Color.Black)

For i As Integer = 0 To 9

g.DrawLine(p1, intBaseX + 45 * i – 4, intBaseY – 5, _

intBaseX + 45 * i – 4, intBaseY + 45 * 9 – 5)

g.DrawLine(p2, intBaseX + 45 * i – 3, intBaseY – 4, _

intBaseX + 45 * i – 3, intBaseY + 45 * 9 – 4)

g.DrawLine(p1, intBaseX – 4, intBaseY + 45 * i – 5, _

intBaseX + 45 * 9 – 4, intBaseY + 45 * i – 5)

g.DrawLine(p2, intBaseX – 3, intBaseY + 45 * i – 4, _

intBaseX + 45 * 9 – 3, intBaseY + 45 * i – 4)

Next

End Sub

Private Sub LabelScore_Paint(ByVal sender As System.Object, _

ByVal e As System.Windows.Forms.PaintEventArgs)

DDScore.showNumber(e.Graphics)

End Sub

Private Sub LabelTime_Paint(ByVal sender As System.Object, _

ByVal e As System.Windows.Forms.PaintEventArgs)

DDTime.showTime(e.Graphics)

End Sub

Private Sub tmr1_Tick(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles tmr1.Tick

Dim s As String = lblNameShow.Text

lblNameShow.Text = s.Substring(1) + s.Substring(0, 1)

End Sub

'Счётчик секунд, который обнуляем в начале каждой игры

'в методе NewGame:

Dim secondCounter As Integer

'Время, через которое звучит мелодия

'возможного окончания игры:

Dim EndGameTime As Integer = 60

Private Sub tmr2_Tick(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles tmr2.Tick

DDTime.number += 1

lblTime.Refresh()

'Счётчик секунд:

secondCounter = secondCounter + 1

'Мелодия окончания игры:

If secondCounter = EndGameTime Then

My.Computer.Audio.Play("..\..\Sounds\win.wav", _

AudioPlayMode.Background)

End If

End Sub

'#Region "Preview Balls"

Private Sub PreShow()

Dim col, row As Integer

For i As Integer = 0 To 2

If ThreeBI(i) = -1 Then

prePic(i).Visible = False

Else

prePic(i).Visible = True

prePic(i).Image = Image.FromFile(ImgList(ThreeBI(i)))

col = ThreeBP(i) Mod 9

row = ThreeBP(i) \ 9

prePic(i).Location = New Point(col * 45 + _

intBaseX + (38 – prePic(i).Width) / 2, _

row * 45 + intBaseY + (38 – prePic(i).Height) / 2)

prePic(i).Visible = True

prePic(i).BringToFront()

End If

If ThreeBI(0) <> -1 Then

picBallPre1.Visible = True

picBallPre1.Image = _

Image.FromFile(ImgList(ThreeBI(0)))

End If

If ThreeBI(1) <> -1 Then

picBallPre2.Visible = True

picBallPre2.Image = _

Image.FromFile(ImgList(ThreeBI(1)))

Else

picBallPre2.Visible = False

End If

If ThreeBI(2) <> -1 Then

picBallPre3.Visible = True

picBallPre3.Image = _

Image.FromFile(ImgList(ThreeBI(2)))

Else

picBallPre3.Visible = False

End If

Next

End Sub

Private Sub PrePic_Click(ByVal sender As Object, _

ByVal e As System.EventArgs)

Dim i As Integer = Array.IndexOf(prePic, sender)

Dim MP As MotionPic = MPBoxes(ThreeBP(i))

Call Ball_Click(MP, e)

End Sub

'#Region "Save and Load Game"

Private Sub SaveGame()

Dim strNewLine = Chr(13) + Chr(10)

Dim s As String = Nothing

playerScore = DDScore.number

playerTime = DDTime.number

s += "#Assignment Line" + strNewLine

s += playerName.ToString + strNewLine

s += playerScore.ToString + strNewLine

s += playerTime.ToString + strNewLine

For i As Integer = 0 To 2

s += ThreeBI(i).ToString + ";" + ThreeBP(i).ToString

If i < 2 Then

s += ","

End If

Next

s += strNewLine

For i As Integer = 0 To 80

s += MPBoxes(i).MPState.ToString + ";" + _

MPBoxes(i).MPIndex.ToString

If i < 80 Then

s += ","

End If

Next

Dim SW As StreamWriter = Nothing

Try

SW = New StreamWriter("LSF.vmt")

SW.Write(s)

Catch IOE As IOException

MessageBox.Show("Can't save File !", "Error", _

MessageBoxButtons.OK, MessageBoxIcon.Error)

Catch EX As Exception

MessageBox.Show("Some Error occurs while Saving" + _

strNewLine + "Error :" + EX.ToString, _

"Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

Finally

SW.Close()

End Try

End Sub

Private Sub LoadGame()

Dim strRead(4) As String

Dim strBigArr() As String

Dim strSmallArr() As String

Dim SR As StreamReader = Nothing

If Not File.Exists("LSF.vmt") Then

MessageBox.Show("Save File doesn't Exists", _

"Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)

Exit Sub

End If

Try

SR = New StreamReader("LSF.vmt")

If SR.ReadLine <> "#Assignment Line" Then

MessageBox.Show("Invalid Loaded File", "Error", _

MessageBoxButtons.OK, MessageBoxIcon.Error)

SR.Close()

Exit Sub

End If

For i As Integer = 0 To 4

strRead(i) = SR.ReadLine

Next

Catch IOE As IOException

MessageBox.Show("Can't load File !", "Error", _

MessageBoxButtons.OK, MessageBoxIcon.Error)

Catch EX As Exception

MessageBox.Show("Some Error occurs while Loading" + _

Chr(13) + Chr(10) + "Error :" + EX.ToString, _

"Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

Finally

SR.Close()

End Try

'Information Loaded

playerName = strRead(0)

playerScore = CDbl(strRead(1))

playerTime = CInt(strRead(2))

ReDim strBigArr(2)

ReDim strSmallArr(1)

strBigArr = strRead(3).Split(",")

For i As Integer = 0 To 2

strSmallArr = strBigArr(i).Split(";")

ThreeBI(i) = CInt(strSmallArr(0))

ThreeBP(i) = CInt(strSmallArr(1))

Next

InitBoard(playerName, playerScore, playerTime)

ReDim strBigArr(80)

strBigArr = strRead(4).Split(",")

For i As Integer = 0 To 80

strSmallArr = strBigArr(i).Split(";")

If CInt(strSmallArr(0)) <> BallState.NO_BALL Then

MPBoxes(i).Init(CInt(strSmallArr(1)))

End If

Next

End Sub

В меню Игра дважды щёлкаем по команде Новая (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.2. Метод-обработчик выбора команды.

Private Sub NewGameToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles NewGameToolStripMenuItem.Click

'Обнуляем счётчик секунд:

secondCounter = 0

'Мелодия начала игры:

My.Computer.Audio.Play("..\..\Sounds\drumpad-crash.wav")

Dim plName As String = Nothing

While Trim(plName) = ""

plName = InputBox("Запишите, пожалуйста, Ваше имя " + _

"(оставлять поле пустым нельзя):", "Имя игрока")

End While

InitBoard(plName, 0, 0)

RandomThreeBalls()

GiveThreeBalls()

flagMadeNew = 1

SaveToolStripMenuItem.Enabled = True

End Sub

В меню Игра дважды щёлкаем по команде Сохранить (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.3. Метод-обработчик выбора команды.

Private Sub SaveToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles SaveToolStripMenuItem.Click

SaveGame()

End Sub

В меню Игра дважды щёлкаем по команде Загрузить (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.4. Метод-обработчик выбора команды.

Private Sub LoadToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles LoadToolStripMenuItem.Click

If flagMadeNew = 1 Then

ResetBoard()

End If

LoadGame()

flagMadeNew = 1

SaveToolStripMenuItem.Enabled = True

End Sub

В меню Игра дважды щёлкаем по команде Выход (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.5. Метод-обработчик выбора команды.

Private Sub ExitToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles ExitToolStripMenuItem.Click

Me.Close()

End Sub

В меню Очки дважды щёлкаем по команде Показать (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.6. Метод-обработчик выбора команды.

Private Sub ShowScorToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles ShowScorToolStripMenuItem.Click

Dim frm As Form2 = New Form2

frm.Show()

frm.drawTable()

End Sub

В меню Очки дважды щёлкаем по команде “Рассчитать средние” (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.7. Метод-обработчик щелчка по элементу.

Private Sub CalculateAvgToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles CalculateAvgToolStripMenuItem.Click

Dim strnewL = Chr(13) + Chr(10)

Dim avg As Double = DDScore.number / DDTime.number

Dim s As String = FormatNumber(avg, 3)

Dim h As New System.IntPtr

MessageBox.Show("Очки : " + DDScore.number.ToString + _

" " + "(очков)" + strnewL _

+ "Время : " + DDTime.number.ToString + " " + "(сек)" + _

strnewL + "Среднее значение : " + s + " " + _

"(очков/сек)", "Среднее значение очков в секунду", _

MessageBoxButtons.OK, MessageBoxIcon.None)

End Sub

В меню Помощь дважды щёлкаем по команде “О программе” (для элемента управления MenuStrip). Появляется шаблон метода, который после записи нашего кода принимает следующий вид.

Листинг 21.8. Метод-обработчик выбора команды.

Private Sub AboutToolStripMenuItem_Click( _

ByVal sender As System.Object, ByVal e As System.EventArgs) _

Handles AboutToolStripMenuItem.Click

Dim frm As New Form3

frm.Show()

End Sub

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

Мы закончили написание программы в главный класс Form1 (для формы Form1 с пользовательским интерфейсом игры).

Теперь в наш проект добавляем новые файлы (для программирования соответствующих игровых действий). Добавить в проект файл можно по двум вариантам.

По первому варианту, добавляем в проект нужный файл по обычной схеме: в панели Solution Explorer выполняем правый щелчок по имени проекта, в контекстном меню выбираем Add, Existing Item, в панели Add Existing Item в окне “Files of type” выбираем “All Files”, в центральном окне находим (например, в папке компьютера файл, скопированный из Интернета), выделяем имя этого файла и щёлкаем кнопку Add (или дважды щёлкаем по имени этого файла).

По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя DPaint.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.

Листинг 21.9. Новый файл.

Public Class DPaint

Private _number As String

Private _position As Point

Private _color As Color

Private _pen As Pen

Private _thick As Integer

Private _width As Integer

Private _brush As SolidBrush

#Region "Property Declaration"

Public Sub New()

'_color = Color.Yellow

'Для большей чёткости задаём красный цвет цифр для очков

'и времени:

_color = Color.Red

_brush = New SolidBrush(_color)

_number = 0

End Sub

Public Sub New(ByVal number As Integer)

Me.number = number

_color = Color.Yellow

_brush = New SolidBrush(_color)

End Sub

Public Property number() As Double

Get

Return CDbl(_number)

End Get

Set(ByVal Value As Double)

_number = Value.ToString

_number = _number.PadLeft(8, "0")

End Set

End Property

Public Property position() As Point

Get

Return _position

End Get

Set(ByVal Value As Point)

_position = Value

End Set

End Property

Public Property thick() As Integer

Get

Return _thick

End Get

Set(ByVal Value As Integer)

_thick = Value

End Set

End Property

Public Property width() As Integer

Get

Return _width

End Get

Set(ByVal Value As Integer)

_width = Value

End Set

End Property

#End Region

#Region "Show digital Number"

Private Function conPol(ByVal i As Integer) As Point()

Dim c, h As Integer

Dim x As Integer = _position.X

Dim y As Integer = _position.Y

Dim poly(3) As Point

Select Case i

Case 1

c = x

h = y – _width – 2

poly(0).X = c

poly(0).Y = h

poly(1).X = c + _width

poly(1).Y = h

poly(2).X = c + _width – _thick

poly(2).Y = h + _thick

poly(3).X = c + _thick

poly(3).Y = h + _thick

Return poly

Case 2

c = x + _width

h = y – _width – 1

poly(0).X = c

poly(0).Y = h

poly(1).X = c

poly(1).Y = h + _width

poly(2).X = c – _thick

poly(2).Y = h + _width – _thick / 2

poly(3).X = c – _thick

poly(3).Y = h + _thick

Return poly

Case 3

c = x + _width

h = y + 1

poly(0).X = c

poly(0).Y = h

poly(1).X = c

poly(1).Y = h + _width

poly(2).X = c – _thick

poly(2).Y = h + _width – _thick

poly(3).X = c – _thick

poly(3).Y = h + _thick / 2

Return poly

Case 4

c = x + _width

h = y + _width + 2

poly(0).X = c

poly(0).Y = h

poly(1).X = c – _width

poly(1).Y = h

poly(2).X = c – _width + _thick

poly(2).Y = h – _thick

poly(3).X = c – _thick

poly(3).Y = h – _thick

Return poly

Case 5

c = x

h = y + _width + 1

poly(0).X = c

poly(0).Y = h

poly(1).X = c

poly(1).Y = h – _width

poly(2).X = c + _thick

poly(2).Y = h – _width + _thick / 2

poly(3).X = c + _thick

poly(3).Y = h – _thick

Return poly

Case 6

c = x

h = y – 1

poly(0).X = c

poly(0).Y = h

poly(1).X = c

poly(1).Y = h – _width

poly(2).X = c + _thick

poly(2).Y = h – _width + _thick

poly(3).X = c + _thick

poly(3).Y = h – _thick / 2

Return poly

Case 7

ReDim poly(5)

c = x

h = y

poly(0).X = c

poly(0).Y = h

poly(1).X = c + _thick

poly(1).Y = h – _thick / 2

poly(2).X = c + _width – _thick

poly(2).Y = h – _thick / 2

poly(3).X = c + _width

poly(3).Y = h

poly(4).X = c + _width – _thick

poly(4).Y = h + _thick / 2

poly(5).X = c + _thick

poly(5).Y = h + _thick / 2

Return poly

End Select

End Function

Private Sub show(ByVal g As Graphics, ByVal led1 As Boolean, _

ByVal led2 As Boolean, ByVal led3 As Boolean, _

ByVal led4 As Boolean, ByVal led5 As Boolean, _

ByVal led6 As Boolean, ByVal led7 As Boolean)

led(g, 1, led1)

led(g, 2, led2)

led(g, 3, led3)

led(g, 4, led4)

led(g, 5, led5)

led(g, 6, led6)

led(g, 7, led7)

End Sub

Private Sub led(ByVal g As Graphics, ByVal led As Integer, _

ByVal sta As Boolean)

If (sta) Then

g.FillPolygon(_brush, conPol(led))

End If

End Sub

Private Sub showANum(ByVal g As Graphics, ByVal num As Integer)

Select Case num

Case 0

show(g, True, True, True, True, True, True, False)

Case 1

show(g, False, True, True, False, False, False, False)

Case 2

show(g, True, True, False, True, True, False, True)

Case 3

show(g, True, True, True, True, False, False, True)

Case 4

show(g, False, True, True, False, False, True, True)

Case 5

show(g, True, False, True, True, False, True, True)

Case 6

show(g, True, False, True, True, True, True, True)

Case 7

show(g, True, True, True, False, False, False, False)

Case 8

show(g, True, True, True, True, True, True, True)

Case 9

show(g, True, True, True, True, False, True, True)

End Select

End Sub

Public Sub showNumber(ByVal g As Graphics)

Dim tempnum As Integer

Dim tempPos As Point = _position

For i As Integer = 0 To _number.Length – 1

tempnum = _number.Substring(i, 1)

showANum(g, CInt(tempnum))

_position.X += _width + 2

Next

_position = tempPos

End Sub

#End Region

#Region "Show Time"

Private Sub show2Points(ByVal g As Graphics)

Dim r1 As Integer = _position.Y + _width / 2 – 2

Dim r2 As Integer = _position.Y – _width / 2 – 2

Dim c As Integer = _position.X + _width / 2 – 2

g.FillEllipse(_brush, c, r1, _width \ 3, _width \ 3)

g.FillEllipse(_brush, c, r2, _width \ 3, _width \ 3)

End Sub

Public Sub showTime(ByVal g As Graphics)

Dim num As Integer = CInt(_number)

Dim tempPos As Point = _position

Dim l As Integer = IIf(num = 3600, 8, 5)

Dim h As Integer = num \ 3600

Dim m As Integer = (num Mod 3600) \ 60

Dim s As Integer = num Mod 60

showANum(g, h \ 10)

_position.X += _width + 2

showANum(g, h Mod 10)

_position.X += _width + 2

show2Points(g)

_position.X += _width + 2

showANum(g, m \ 10)

_position.X += _width + 2

showANum(g, m Mod 10)

_position.X += _width + 2

show2Points(g)

_position.X += _width + 2

showANum(g, s \ 10)

_position.X += _width + 2

showANum(g, s Mod 10)

_position = tempPos

End Sub

#End Region

End Class

По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя mModule.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.

Листинг 21.10. Новый файл.

Public Module mModule

Private s As String = Application.StartupPath & "..\..\"

'Public ImgList() As String = {s & "BlackBall.png",

's & "M_BlackBall.png", s & "BlueBall.png" _

', s & "M_BlueBall.png", s & "GreenBall.png", s &

'"M_GreenBall.png", s & "LGreenBall.png" _

', s & "M_LGreenBall.png", s & "MagentaBall.png", s &

'"M_MagentaBall.png" _

', s & "RedBall.png", s & "M_RedBall.png"}

'Исправляем ошибку:

Public ImgList() As String = _

{"..\..\BlackBall.png", "..\..\M_BlackBall.png", _

"..\..\BlueBall.png", "..\..\M_BlueBall.png", _

"..\..\GreenBall.png", "..\..\M_GreenBall.png", _

"..\..\LGreenBall.png", "..\..\M_LGreenBall.png", _

"..\..\MagentaBall.png", "..\..\M_MagentaBall.png", _

"..\..\RedBall.png", "..\..\M_RedBall.png"}

Public Structure Player

Private _PlayerName As String

Private _PlayerScore As String

Public Sub New(ByVal PlayerName As String, _

ByVal PlayerScore As String)

_PlayerName = PlayerName

_PlayerScore = PlayerScore

End Sub

Public Property PlayerName() As String

Get

Return _PlayerName

End Get

Set(ByVal Value As String)

_PlayerName = Value

End Set

End Property

Public Property PlayerScore() As String

Get

Return _PlayerScore

End Get

Set(ByVal Value As String)

_PlayerScore = Value

End Set

End Property

End Structure

End Module

По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя MotionPic.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.

Листинг 21.11. Новый файл.

Option Strict On

Public Enum BallState

ZOOMING_BALL = -2

NO_BALL = -1

NORMAL_BALL = 0

JUMPING_BALL = 1

DESTROYING_BALL = 2

End Enum

Public Class MotionPic

Inherits System.Windows.Forms.PictureBox

Private myTimer As New System.Windows.Forms.Timer

Private picWidth As Integer

Private picHeight As Integer

Private picTop As Integer

Private picLeft As Integer

Private picState As Integer

Private picIndex As Integer

Private sign As Integer

#Region "Property Declaration"

Public Sub New(ByVal eSize As Size, ByVal eLocation As Point)

Me.Size = eSize

Me.Location = eLocation

picWidth = Me.Width

picHeight = Me.Height

picTop = Me.Top

picLeft = Me.Left

picState = BallState.NO_BALL

picIndex = -1

End Sub

Public ReadOnly Property MPState() As Integer

Get

Return picState

End Get

End Property

Public ReadOnly Property MPIndex() As Integer

Get

Return picIndex

End Get

End Property

Public Sub Init()

Me.Init(CInt(Rnd() * 12))

End Sub

#End Region

Public Sub Init(ByVal value As Integer)

picIndex = value

picState = BallState.ZOOMING_BALL