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


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) _

Назад Дальше