multiplayermode = True
End Sub
Private Sub Layer_A_Click (Index As Integer)
playerdisplaylabel. Caption = ""
'Used For single player board selection or multiplayer your turn selection
Debug. Print "Layer A Click Turn Status " & MyTurn
Debug. Print "Layer A Multiplayer Mode Status " & multiplayermode
If multiplayermode = True And MyTurn = False Then 'Easy way to exit if not your turn
Exit Sub
End If
If Sq_Left Mod 2 = 1 Then 'check remainder of squares left divided by 2
If sw = True Then ' sets who goes first X or O
Layer_A (Index). Caption = "X"
Else
Layer_A (Index). Caption = "O"
End If
Layer_A (Index). Enabled = False 'Sets selected square to not available
Player_A (Index) = 1
Computer_A (Index) = - Token
LoadPlayer
If multiplayermode = True And MyTurn = True Then 'checks for multiplayer and turn status
'This routine below packs message to send
'to other player to select the square chosen.
Dim dpmsg As DirectPlayMessage 'alot direct playmessage
Set dpmsg = dxplay. CreateMessage 'set and create the message
Call dpmsg. WriteLong (MSG_MOVE) 'pack message structure and identify type
Call dpmsg. WriteByte (Index) 'Packs case selection number to msgtype.
'This sends the pack message structure
Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg)
End If
If multiplayermode = True Then 'Sets routines to not your turn on multiplayer
Dim Y As Integer
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("nyt", vbResIcon)
Next Y
'Update Status displays
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & opponentsname & "'s Turn"
Out_Box. Caption = opponentsname & "'s Turn."
End If
'Everything below until mod else statement is single player
If multiplayermode = False Then 'Sets X or O turn status on single player
If sw = True Then
StatusBar1. SimpleText = "New Game Initialized O's Turn"
Else
StatusBar1. SimpleText = "New Game Initialized X's Turn"
End If
If sw = True Then
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Next Y
Else
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Next Y
End If
If sw = True Then
Out_Box. Caption = "O's Turn"
Else
Out_Box. Caption = "X's Turn"
End If
End If
Else
'Mod else*********************************
If sw = True Then
Layer_A (Index). Caption = "O"
Else
Layer_A (Index). Caption = "X"
End If
Layer_A (Index). Enabled = False
Player_A (Index) = - Token
Computer_A (Index) = 1
If multiplayermode = True Then
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & opponentsname & "'s Turn"
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("nyt", vbResIcon)
Next Y
Out_Box. Caption = opponentsname & "'s Turn."
End If
If multiplayermode = False Then
If sw = True Then
StatusBar1. SimpleText = "New Game Initialized X's Turn"
Else
StatusBar1. SimpleText = "New Game Initialized O's Turn"
End If
If sw = True Then
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Next Y
Out_Box. Caption = "X's Turn"
Else
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Next Y
Out_Box. Caption = "O's Turn"
End If
End If
LoadComputer
If multiplayermode = True And MyTurn = True Then
'Same as above packs message and sends move to other player
Dim dpmsg2 As DirectPlayMessage
Set dpmsg2 = dxplay. CreateMessage
Call dpmsg2. WriteLong (MSG_MOVE)
Call dpmsg2. WriteByte (Index)
Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg2)
End If
End If
Sq_Left = Sq_Left - 1
EvalNextMove
MyTurn = False
End Sub
Public Function layer_A_online (Index As Integer)
playerdisplaylabel. Caption = ""
'This routine is called to mark sqares when remote computer
'sends a move made command.
'Same as above with some redundant routines removed
If Sq_Left Mod 2 = 1 Then
If sw = True Then
Layer_A (Index). Caption = "X"
Else
Layer_A (Index). Caption = "O"
End If
Layer_A (Index). Enabled = False
Player_A (Index) = 1
Computer_A (Index) = - Token
If multiplayermode = True Then
If sw = True Then
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & profilename & "'s Turn"
Out_Box. Caption = profilename & "'s Turn."
Dim Y As Integer
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Next Y
Else
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & profilename & "'s Turn"
Out_Box. Caption = profilename & "'s Turn."
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Next Y
End If
End If
If multiplayermode = False Then
If sw = True Then
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Out_Box. Caption = "O's Turn"
Next Y
Else
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Out_Box. Caption = "X's Turn"
Next Y
End If
End If
LoadPlayer
Else
If sw = True Then
Layer_A (Index). Caption = "O"
Else
Layer_A (Index). Caption = "X"
End If
Layer_A (Index). Enabled = False
Player_A (Index) = - Token
Computer_A (Index) = 1
If multiplayermode = True Then
If sw = True Then
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & profilename & "'s Turn"
Out_Box. Caption = profilename & "'s Turn."
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Next Y
Else
StatusBar1. SimpleText = "Game count is " & score & " " & opponentsname & ": " & opponentsscore & " | " & profilename & ": " & profilenamescore & " " & profilename & "'s Turn"
Out_Box. Caption = profilename & "'s Turn."
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Next Y
End If
End If
If multiplayermode = False Then
If sw = True Then
StatusBar1. SimpleText = "New Game Initialized X's Turn"
Else
StatusBar1. SimpleText = "New Game Initialized O's Turn"
End If
If sw = True Then
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("x", vbResIcon)
Next Y
Out_Box. Caption = "X's Turn"
Else
Y = 0
For Y = 0 To 8
Layer_A (Y). MouseIcon = LoadResPicture ("o", vbResIcon)
Next Y
Out_Box. Caption = "O's Turn"
End If
End If
LoadComputer
End If
Sq_Left = Sq_Left - 1
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
chatlabel. Visible = False
send_chat. Visible = False
chatbox. Visible = False
mnuchat. Checked = False
Else
Frame1. Visible = True
chatlabel. Visible = True
send_chat. Visible = True
chatbox. Visible = True
mnuchat. Checked = True
chatbox. Visible = True