Справочник Жаркова по проектированию и программированию искусственного интеллекта. Том 6: Программирование на Visual Basic искусственного интеллекта. Продолжение 2

21.4. Код программы

Открываем файл Form1.vb (например, так: File, Open, File) и вверху записываем директиву для подключения требуемого пространства имен:

Imports System.IO 'Для класса StreamWriter.

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

Теперь в классе Form1 нашего проекта записываем следующие переменные и методы.

Листинг 21.1. Переменные и методы.

Const intBaseX As Integer = 10

Const intBaseY As Integer = 120

Dim Rand As New Random

'***

Dim playerName As String

Dim playerScore As Double

Dim playerTime As Integer

Dim DDScore As New DPaint

Dim DDTime As New DPaint

'***

Dim intFlag As Integer = -1

Dim flagMadeNew = 0

Dim posMoveTo As Integer

Dim MPBoxes(80) As MotionPic

Dim ThreeBI(2) As Integer

Dim ThreeBP(2) As Integer

Dim prePic(2) As PictureBox

Private Sub InitBoard(ByVal plName As String, _

ByVal plScore As Double, ByVal plTime As Integer)

playerName = plName

playerScore = plScore

playerTime = plTime

If flagMadeNew = 0 Then

Dim i As Integer

Dim intX = intBaseX + 2

Dim intY = intBaseY + 2

For i = 0 To 80

Dim MP As New MotionPic(New Size(36, 36), _

New Point(intX, intY))

MP.SizeMode = PictureBoxSizeMode.StretchImage

intX += 45

If (i + 1) Mod 9 = 0 Then

intY += 45

intX = intBaseX + 2

End If

AddHandler MP.Click, AddressOf Ball_Click

MPBoxes(i) = MP

Next

Me.Controls.AddRange(MPBoxes)

DDScore.width = lblScore.Height / 2 – 6

DDScore.thick = DDScore.width / 4

DDScore.position = New Point(lblScore.Width – _

(DDScore.width + 2) * 9, lblScore.Height / 2)

DDTime.width = lblTime.Height / 2 – 6

DDTime.thick = DDTime.width / 4

DDTime.position = New Point(lblTime.Width – _

(DDTime.width + 2) * 9, lblTime.Height / 2)

AddHandler lblScore.Paint, AddressOf LabelScore_Paint

lblScore.Refresh()

AddHandler lblTime.Paint, AddressOf LabelTime_Paint

lblTime.Refresh()

For i = 0 To 2

prePic(i) = New PictureBox

prePic(i).SizeMode = PictureBoxSizeMode.StretchImage

prePic(i).Size = New Size(16, 16)

prePic(i).Visible = False

Me.Controls.Add(prePic(i))

AddHandler prePic(i).Click, AddressOf PrePic_Click

prePic(i).BringToFront()

Next

Else

ResetBoard()

End If

lblNameShow.Text = playerName

If playerName.Length > 8 Then

lblNameShow.Text += " "

tmr1.Enabled = True

End If

tmr2.Enabled = True

DDScore.number = plScore

lblScore.Refresh()

DDTime.number = plTime

lblTime.Refresh()

PreShow()

End Sub

Private Sub FindSol(ByVal i As Integer)

If MPBoxes(i).Tag <> "" Or MPBoxes(i).Tag = "Here" Then

Return

Else

MPBoxes(i).Tag = "Here"

End If

Select Case TestABox(i)

Case 1

FindSol(1)

FindSol(9)

Case 2

FindSol(7)

FindSol(17)

Case 3

FindSol(71)

FindSol(79)

Case 4

FindSol(63)

FindSol(73)

Case 5

FindSol(i + 1)

FindSol(i + 9)

FindSol(i – 1)

Case 6

FindSol(i – 9)

FindSol(i – 1)

FindSol(i + 9)

Case 7

FindSol(i – 1)

FindSol(i – 9)

FindSol(i + 1)

Case 8

FindSol(i – 9)

FindSol(i + 1)

FindSol(i + 9)

Case Else

FindSol(i – 9)

FindSol(i + 9)

FindSol(i + 1)

FindSol(i – 1)

End Select

End Sub

Private Sub ResetAllTag()

For Each Pic As MotionPic In MPBoxes

If Pic.Tag = "Here" Then

Pic.Tag = ""

End If

Next

End Sub

Private Function TestABox(ByVal val As Integer)

Select Case val

Case 0 : Return 1

Case 8 : Return 2

Case 80 : Return 3

Case 72 : Return 4

Case 1 To 7 : Return 5

Case 73 To 79 : Return 7

Case 17, 26, 35, 44, 53, 62, 71 : Return 6

Case 9, 18, 27, 36, 45, 54, 63 : Return 8

Case Else : Return 0

End Select

End Function

'Serious trouble happened – think more

Private Function GiveThreeBalls() As Boolean

If ThreeBI(1) = -1 Then 'Review for Game over

Return False

Else

For i As Integer = 0 To 2

If ThreeBI(i) = -1 Then

Exit For

Else

If MPBoxes(ThreeBP(i)).MPState = BallState. _

NO_BALL And ThreeBP(i) <> posMoveTo Then

MPBoxes(ThreeBP(i)).Init(ThreeBI(i))

CalWin(ThreeBP(i))

End If

End If

Next

End If

RandomThreeBalls()

PreShow()

Return True

End Function

Private Function IsFullBoard() As Boolean

Dim i As Integer

For Each Pic As PictureBox In MPBoxes

If MPBoxes(i).MPState <> BallState.NO_BALL Then

i += 1

End If

Next

If i = 81 Then

Return True

Else

Return False

End If

End Function

Private Sub RandomThreeBalls()

Dim ArrL As New ArrayList

Dim i As Integer

Dim pos As Integer

Dim ind As Integer

For i = 0 To 80

If MPBoxes(i).MPState = BallState.NO_BALL Or _

MPBoxes(i).MPState = BallState.DESTROYING_BALL Then

ArrL.Add(i)

End If

Next

For i = 0 To IIf(ArrL.Count > 2, 2, ArrL.Count – 1)

pos = Rand.Next(0, ArrL.Count)

pos = CInt(ArrL(pos))

ArrL.Remove(pos)

ThreeBP(i) = pos

ind = Rand.Next(0, 12)

ind = (ind \ 2) * 2

ThreeBI(i) = ind

Next

For j As Integer = i To 2

ThreeBI(j) = -1

ThreeBP(j) = -1

Next

End Sub

'#Region "Check for Calculate Score"

Private Function CheckHor(ByVal pos As Integer) As Integer

Dim type As Integer = MPBoxes(pos).MPIndex

Dim i As Integer = (pos \ 9) * 9

Dim count As Integer

Dim startpos As Integer = i

Dim endpos As Integer = i

While i < (pos \ 9) * 9 + 9

If MPBoxes(i).MPIndex = type Then

endpos += 1

count = endpos – startpos

Else

If count > 4 Then

While MPBoxes(pos).MPState = _

BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j).Destroy()

Next

Return count

End If

If i >= (pos \ 9) * 9 + 5 Then

Return count

End If

startpos = i + 1

endpos = i + 1

End If

i += 1

End While

If count > 4 Then

While MPBoxes(pos).MPState = BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j).Destroy()

Next

Return count

End If

End Function

Private Function CheckVer(ByVal pos As Integer) As Integer

Dim type As Integer = MPBoxes(pos).MPIndex

Dim i As Integer = pos Mod 9

Dim count As Integer

Dim startpos As Integer = i

Dim endpos As Integer = i

While i < (pos Mod 9) + 73

If MPBoxes(i).MPIndex = type Then

endpos += 9

count = (endpos – startpos) / 9

Else

If count > 4 Then

While MPBoxes(pos).MPState = _

BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 9).Destroy()

Next

Return count

End If

If i >= (pos Mod 9) + 36 Then

Return count

End If

startpos = i + 9

endpos = i + 9

End If

i += 9

End While

If count > 4 Then

While MPBoxes(pos).MPState = BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 9).Destroy()

Next

Return count

End If

End Function

Private Function CheckLR(ByVal pos As Integer) As Integer

If pos = 5 Or pos = 6 Or pos = 7 Or pos = 8 Or pos = 15 _

Or pos = 16 Or pos = 17 _

Or pos = 25 Or pos = 26 Or pos = 35 Or pos = 45 _

Or pos = 54 Or pos = 55 _

Or pos = 63 Or pos = 64 Or pos = 65 Or pos = 72 _

Or pos = 73 Or pos = 74 Or pos = 75 Then

Return 0

End If

Dim type As Integer = MPBoxes(pos).MPIndex

Dim i As Integer = pos Mod 10

i = IIf(i = 8, 18, IIf(i = 7, 27, IIf(i = 6, 36, i)))

Dim count As Integer

Dim startpos As Integer = i

Dim endpos As Integer = i

Dim tempi As Integer = i + 1

Dim temp As Integer

If i < 9 Then

temp = 9 – i

Else

temp = 9 – (i \ 9)

End If

While i < tempi + (temp – 1) * 10

If MPBoxes(i).MPIndex = type Then

endpos += 10

count = (endpos – startpos) \ 10

Else

If count > 4 Then

While MPBoxes(pos).MPState = _

BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 10).Destroy()

Next

Return count

End If

If i >= pos + 40 Then

Return count

End If

startpos = i + 10

endpos = i + 10

End If

i += 10

End While

If count > 4 Then

While MPBoxes(pos).MPState = BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 10).Destroy()

Next

Return count

End If

End Function

Private Function CheckRL(ByVal pos As Integer) As Integer

If pos = 0 Or pos = 1 Or pos = 2 Or pos = 3 Or pos = 9 _

Or pos = 10 Or pos = 11 _

Or pos = 18 Or pos = 19 Or pos = 27 Or pos = 53 _

Or pos = 61 Or pos = 62 _

Or pos = 69 Or pos = 70 Or pos = 71 Or pos = 77 _

Or pos = 78 Or pos = 79 Or pos = 80 Then

Return 0

End If

Dim type As Integer = MPBoxes(pos).MPIndex

Dim i As Integer = pos Mod 8

If i = 0 Then

i = 8

ElseIf i < 4 Then

i = (i + 1) * 8 + i

ElseIf pos \ 8 >= 5 Then

i = 45

End If

Dim count As Integer

Dim startpos As Integer = i

Dim endpos As Integer = i

Dim tempi As Integer = i + 1

Dim temp As Integer

If i < 9 Then

temp = i + 1

Else

temp = 9 – (i \ 8)

End If

While i < tempi + temp * 8

If MPBoxes(i).MPIndex = type Then

endpos += 8

count = (endpos – startpos) \ 8

Else

If count > 4 Then

While MPBoxes(pos).MPState = _

BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 8).Destroy()

Next

Return count

End If

If i >= pos + 32 Then

Return count

End If

startpos = i + 8

endpos = i + 8

End If

i += 8

End While

If count > 4 Then

While MPBoxes(pos).MPState = BallState.ZOOMING_BALL

Application.DoEvents()

End While

For j As Integer = 0 To count – 1

MPBoxes(startpos + j * 8).Destroy()

Next

Return count

End If

End Function

Private Function CalWin(ByVal pos As Integer) As Integer

Dim point As Integer = CheckHor(pos)

If point < 4 Then

point = CheckVer(pos)

End If

If point < 4 Then

point = CheckLR(pos)

End If

If point < 4 Then

point = CheckRL(pos)

End If

If point > 4 Then

Dim dpoint As Double = point * 100 + (dpoint \ 6) * 100

Dim n As Double = DDScore.number + dpoint

For i As Double = DDScore.number To n Step 10

DDScore.number = i

lblScore.Refresh()

Next

DDScore.number = n

Return point

Else

Return 0

End If

End Function

'#Region "Ball Event And Paint Board"

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

ByVal e As System.EventArgs)

CType(sender, MotionPic).Jump()

If CType(sender, MotionPic).MPState <> _

BallState.NO_BALL Then

If intFlag <> -1 Then

MPBoxes(intFlag).Jump()

End If

'intFlag = MPBoxes.IndexOf(MPBoxes, sender)

'Исправляем предупреждение:

intFlag = Array.IndexOf(MPBoxes, sender)

ElseIf intFlag <> -1 Then

Dim tempS As String = MPBoxes(intFlag).Tag

MPBoxes(intFlag).Tag = ""

FindSol(intFlag)

If sender.tag = "Here" Then

'posMoveTo = MPBoxes.IndexOf(MPBoxes, sender)

'Исправляем предупреждение:

posMoveTo = Array.IndexOf(MPBoxes, sender)

If posMoveTo = ThreeBP(0) Then

prePic(0).SendToBack()

ElseIf posMoveTo = ThreeBP(1) Then

prePic(1).SendToBack()

ElseIf posMoveTo = ThreeBP(2) Then

prePic(2).SendToBack()

End If

CType(sender, MotionPic).Init(MPBoxes(intFlag). _

MPIndex)

MPBoxes(intFlag).Destroy()

While MPBoxes(intFlag).MPState = _

BallState.DESTROYING_BALL

Application.DoEvents()

End While

If CalWin(posMoveTo) = 0 Then

If GiveThreeBalls() = False Then

playerScore = DDScore.number

Dim frm As Form2 = New Form2

frm.AddPlayer() = _

New Player(playerName, playerScore)

frm.Show()

frm.PlashScreen()

frm.drawTable()

ResetBoard()

End If

End If

PreShow()

intFlag = -1

Else

MPBoxes(intFlag).Tag = tempS

End If

ResetAllTag()

End If

End Sub

Private Sub ResetBoard()

ThreeBI(0) = -1

tmr1.Enabled = False

tmr2.Enabled = False

playerScore = 0

playerTime = 0

DDScore.number = 0

DDTime.number = 0

Me.Refresh()

PreShow()

lblNameShow.Text = ""

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

Dim i As Integer = ImgList(value).LastIndexOf("\")

Me.Tag = ImgList(value).Substring(i + 1, _

ImgList(value).Length – i – 5)

ZoomIn()

End Sub

Private Sub ZoomIn()

Me.Top = picTop + (picHeight – 4) \ 2

Me.Left = picLeft + (picWidth – 4) \ 2

Me.Width = 4

Me.Height = 4

Me.Image = Image.FromFile(ImgList(picIndex))