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
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"
first_turn = 1
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
Out_Box. Caption = profilename & " Won!"
profilenamescore = profilenamescore + 1
If multiplayermode = True And usermode = "client" Then
If sw = True Then
If multiplayermode = False Then 'Single Player updating
Out_Box. Caption = "O Won!!!!"
Out_Box. Caption = "X Won!!!!!"
Game_Over. Caption = "Game Over"
'Shows Resart Option if Host
restart. Visible = True
restart. Enabled = True
Timer4. Enabled = True 'Sets timer to time mark routine
If sw = True Then 'Checks Whos turn sends string to mark
Call Mark_Win ("O")
Call Mark_Win ("X")
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
If multiplayermode = False Then
Out_Box. Caption = "X Won!!!!"
Out_Box. Caption = "O Won!!!!!"
Timer4. Enabled = True
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
Layer_A (mark). FontBold = True
Wend
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
sample = sample + 1
Next n
Test_Result (sample) = a (n) + a (n + 3) + a (n + 6)
Win (0) = n
Win (1) = n + 3
Win (2) = n + 6
Test_Result (sample) = a (0) + a (4) + a (8)
Win (0) = 0
Win (1) = 4
Win (2) = 8
Test_Result (sample) = a (6) + a (4) + a (2)
Win (0) = 6
Win (2) = 2
Private Sub LoadPlayer ()
Dim e As Integer
For e = 0 To 8
a (e) = Player_A (e)
Next e
Private Sub LoadComputer ()
Dim w As Integer
For w = 0 To 8
a (w) = Computer_A (w)
Next w
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!"
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)
Frame1. Visible = True
chatlabel. Visible = True
send_chat. Visible = True
chatbox. Visible = True
mnuchat. Checked = True
chatbox. SetFocus
Dim chaton2 As DirectPlayMessage
Set chaton2 = dxplay. CreateMessage
Call chaton2. WriteLong (MSG_CHAT_ON)
Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, chaton2)
Exit Sub
NoChat:
MsgBox "Could Not Start Chat", vbOKOnly, "Oops"
Public Function chatswitch () 'Menu button for incoming online Chatbox routine
On Error GoTo NoChat
Страницы: 1, 2, 3, 4, 5