EvalNextMove

End Function

Private Sub scan_3 () '*****************************************

Dim r As Integer

For r = 0 To 7

If Test_Result (r) = 3 Then

Temp = True

End If

Next r

End Sub

Private Sub EvalNextMove () '***********************************

test

scan_3

Debug. Print "Squares Left Value on Evaluate Next Move " & Sq_Left

Debug. Print "Boolean Temp Value on Evaluate " & Temp

Debug. Print "Token Value on Eval." & Token

If Temp = True Then

If Sq_Left Mod 2 = 0 Then 'Makes win or lose calls Turn checking is made later

Player_Wins 'call player wins routine

Else

Computer_Wins 'calls computer rountine

End If

End If

Temp = False

If Sq_Left <= 0 Then

Cats_Game

Begin = False 'Turns off mark routine

If multiplayermode = True And usermode = "host" Then 'sets turn to true

MyTurn = True

Debug. Print "Set myturn to true on win"

End If

End If

first_turn = 1

End Sub

Private Sub Computer_Wins ()

Dim s As Integer

For s = 0 To 8

Layer_A (s). Enabled = False

Next s

Begin = True

If multiplayermode = True And usermode = "host" Then

If sw = True Then 'Checks for Whos Turn and update Host or client

Out_Box. Caption = opponentsname & " Won!"

opponentsscore = opponentsscore + 1

Else

Out_Box. Caption = profilename & " Won!"

profilenamescore = profilenamescore + 1

End If

End If

If multiplayermode = True And usermode = "client" Then

If sw = True Then

Out_Box. Caption = profilename & " Won!"

profilenamescore = profilenamescore + 1

Else

Out_Box. Caption = opponentsname & " Won!"

opponentsscore = opponentsscore + 1

End If

End If

If multiplayermode = False Then 'Single Player updating

If sw = True Then

Out_Box. Caption = "O Won!!!!"

Else

Out_Box. Caption = "X Won!!!!!"

End If

End If

Game_Over. Caption = "Game Over"

'Shows Resart Option if Host

If multiplayermode = True And usermode = "host" Then

restart. Visible = True

restart. Enabled = True

End If

Timer4. Enabled = True 'Sets timer to time mark routine

If sw = True Then 'Checks Whos turn sends string to mark

Call Mark_Win ("O")

Else

Call Mark_Win ("X")

End If

End Sub

Private Sub Player_Wins ()

'See computer wins for details

Dim a As Integer

For a = 0 To 8

Layer_A (a). Enabled = False

Next a

Begin = True

If multiplayermode = True And usermode = "host" Then

If sw = True Then

profilenamescore = profilenamescore + 1

Out_Box. Caption = profilename & " Won!"

Else

opponentsscore = opponentsscore + 1

Out_Box. Caption = opponentsname & " Won!"

End If

End If

If multiplayermode = True And usermode = "client" Then

If sw = True Then

opponentsscore = opponentsscore + 1

Out_Box. Caption = opponentsname & " Won!"

Else

profilenamescore = profilenamescore + 1

Out_Box. Caption = profilename & " Won!"

End If

End If

If multiplayermode = False Then

If sw = True Then

Out_Box. Caption = "X Won!!!!"

Else

Out_Box. Caption = "O Won!!!!!"

End If

End If

Game_Over. Caption = "Game Over"

If multiplayermode = True And usermode = "host" Then

restart. Visible = True

restart. Enabled = True

End If

Timer4. Enabled = True

If sw = True Then

Call Mark_Win ("X")

Else

Call Mark_Win ("O")

End If

End Sub

Private Sub Mark_Win (tr As String) 'Marks winning squares

Dim PauseTime, start, Finish, TotalTime

While Begin = True

PauseTime = 0.3 ' Set duration.

start = Timer ' Set start time.

Do While Timer < start + PauseTime And Begin = True

For n1 = 0 To 2

mark = Win (n1)

Layer_A (mark). Caption = tr

Layer_A (mark). FontBold = False

Next n1

DoEvents ' Yield to other processes.

Loop

start = Timer ' Set start time.

Do While Timer < start + PauseTime And Begin = True

For n1 = 0 To 2

mark = Win (n1)

Layer_A (mark). FontBold = True

Layer_A (mark). Caption = tr

Next n1

DoEvents ' Yield to other processes.

Loop

Wend

End Sub

Private Sub test () 'Tests conditions for the win

Dim n, k, sample As Integer

sample = 0

For n = 0 To 2

Test_Result (sample) = a (3 * n) + a (3 * n + 1) + a (3 * n + 2)

If Test_Result (sample) = 3 Then

Win (0) = 3 * n

Win (1) = 3 * n + 1

Win (2) = 3 * n + 2

End If

sample = sample + 1

Next n

For n = 0 To 2

Test_Result (sample) = a (n) + a (n + 3) + a (n + 6)

If Test_Result (sample) = 3 Then

Win (0) = n

Win (1) = n + 3

Win (2) = n + 6

End If

sample = sample + 1

Next n

Test_Result (sample) = a (0) + a (4) + a (8)

If Test_Result (sample) = 3 Then

Win (0) = 0

Win (1) = 4

Win (2) = 8

End If

sample = sample + 1

Test_Result (sample) = a (6) + a (4) + a (2)

If Test_Result (sample) = 3 Then

Win (0) = 6

Win (1) = 4

Win (2) = 2

End If

sample = sample + 1

End Sub

Private Sub LoadPlayer ()

Dim e As Integer

For e = 0 To 8

a (e) = Player_A (e)

Next e

End Sub

Private Sub LoadComputer ()

Dim w As Integer

For w = 0 To 8

a (w) = Computer_A (w)

Next w

End Sub

Private Sub Cats_Game () 'Cats Game display routine

GameUnderway = False

Dim z As Integer

For z = 0 To 8

Layer_A (z). Enabled = False

Next z

Out_Box. Caption = "Cat's Game!"

Game_Over. Caption = "Game Over"

If multiplayermode = True And usermode = "host" Then

restart. Visible = True

restart. Enabled = True

End If

End Sub

Private Sub mnuchat_Click () 'Menu button for chatbox routine

On Error GoTo NoChat 'error handler in case chat initialization problem.

If mnuchat. Checked = True Then

Frame1. Visible = False

chatlabel. Visible = False

send_chat. Visible = False

chatbox. Visible = False

mnuchat. Checked = False

'Packs and sends DXplay message to switch chat on off

Dim chaton As DirectPlayMessage

Set chaton = dxplay. CreateMessage

Call chaton. WriteLong (MSG_CHAT_ON)

Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, chaton)

Else

Frame1. Visible = True

chatlabel. Visible = True

send_chat. Visible = True

chatbox. Visible = True

mnuchat. Checked = True

chatbox. Visible = True

chatbox. SetFocus

'Packs and sends DXplay message to switch chat on off

Dim chaton2 As DirectPlayMessage

Set chaton2 = dxplay. CreateMessage

Call chaton2. WriteLong (MSG_CHAT_ON)

Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, chaton2)

End If

Exit Sub

NoChat:

MsgBox "Could Not Start Chat", vbOKOnly, "Oops"

Exit Sub

End Sub

Public Function chatswitch () 'Menu button for incoming online Chatbox routine

On Error GoTo NoChat

If mnuchat. Checked = True Then

Frame1. Visible = False

Страницы: 1, 2, 3, 4, 5