Private Function updatedisplay ()
label7. Visible = True
gameopen. FontUnderline = False
gameopen. ForeColor = vbBlue
host. Enabled = False
join. Enabled = False
Dim Y As Byte
Y = 0
For Y = 0 To 2 Step 1
lantype (Y). Enabled = False
Next Y
End Function
Option Explicit
Dim a (9) As Integer
Dim Player_A (9) As Integer 'Initialize X array
Dim Computer_A (9) As Integer 'Initialize O array
Dim Test_Result (8) As Integer
Dim Win (3) As Integer ' Spots won to marked
Dim m, Token, first_turn, temp1 As Integer
Dim Temp As Boolean 'check whether player won
Dim Sq_Left, n1, mark As Integer
Dim tr As String 'string passed on win to mark routine
Dim Begin As Boolean 'continue winning spots flashing
Dim sw As Boolean 'Sets whether X or O starts game
Public Sub Initialize ()
' select who's turn
If usermode = "host" And multiplayermode = True Then
' set o or x first
If sw = True Then
MyTurn = True
Else
MyTurn = False
End If
If multiplayermode = False Then
Begin = False ' cancel marking routine
score = score + 1 'adds one to gamecount
If multiplayermode = True Then
If usermode = "client" And sw = True Then
ElseIf usermode = "client" And sw = False Then
'Start SW true mode**********************************
'initialize game settings
StatusBar1. SimpleText = "New Game Initialized" & " X's Turn"
Debug. Print "Turn Status " & MyTurn
Debug. Print "SW Value is " & sw
Dim u As Integer
u = 0
Sq_Left = 9
Token = 10
For u = 0 To 8
Layer_A (u). MousePointer = vbCustom
'select starting icon and characteristics****************************
If usermode = "host" Then
Layer_A (u). MouseIcon = LoadResPicture ("x", vbResIcon)
Layer_A (u). MouseIcon = LoadResPicture ("nyt", vbResIcon)
Layer_A (u). FontSize = 28
Layer_A (u). FontBold = True
Layer_A (u). Caption = ""
Layer_A (u). BackStyle = 0
Layer_A (u). Alignment = 2
Player_A (u) = 0
Computer_A (u) = 0
Layer_A (u). Enabled = True
Next u
'update statusbar and display routine******************************
StatusBar1. SimpleText = "New Game Initialized " & profilename & "'s Turn"
Out_Box. Caption = profilename & "'s Turn."
If usermode = "client" And multiplayermode = True Then
StatusBar1. SimpleText = "New Game Initialized " & opponentsname & "'s Turn"
Out_Box. Caption = opponentsname & "'s Turn."
Out_Box. Caption = "X Goes First"
'End sw true*********************************************
'set starting icon*****************
If sw = False Then
StatusBar1. SimpleText = "New Game Initialized" & " O's Turn"
Layer_A (u). MouseIcon = LoadResPicture ("o", vbResIcon)
Temp = False 'initiate no win
'Update Statusbar and outbox display********************8
Out_Box. Caption = profilename & " 's Turn."
Out_Box. Caption = opponentsname & " 's Turn."
Out_Box. Caption = "O Goes First"
'End sw false*********************************************
Debug. Print "Ran Initialization Myturn status is " & MyTurn
Game_Over. Caption = "New Game"
End Sub
Private Sub exit_Click ()
If onconnect = True Then 'checks for connection
On Error GoTo NoDx 'error to handle dxplay not initialized
Dim dpmsg As DirectPlayMessage
Set dpmsg = dxplay. CreateMessage
Call dpmsg. WriteLong (MSG_STOP) 'Sends player quit message to other player
Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg)
Call CloseDownDPlay 'shuts down dxplay
Unload Connect 'unloads connect form if connect frees memory
Unload MainBoard 'unloads board before ending to free memory
End
NoDx:
MsgBox "Could not stop DXPlay. ", vbOKOnly, "System"
Private Sub Form_Load ()
On Error GoTo NoLoad 'Handles errors in case form won't load
MainBoard. Icon = LoadResPicture ("ictac", vbResIcon) 'form icon
restart. Visible = False 'restart button not seen on single player or client mode
mnudisconnect. Enabled = False 'set menu item to no connect state
onconnect = False 'Sets connection status to false by default
sw = True 'set starting Player to x
x. Checked = True 'set menuitem X to x checked
multiplayermode = False 'initiate mode to false
Call deinitialize 'disables all squares until gamemode and multiplayer mode is decided
score = 0 'sets game count to 0
Exit Sub
NoLoad:
MsgBox "Could Not Load Form", vbOKOnly, "Quitting"
Private Sub deinitialize ()
'Disables all squares until game selection is made
Dim m As Integer
For m = 0 To 8
Layer_A (m). MousePointer = vbCustom
If sw = True Then 'sets mouse pointer to x for x first
Layer_A (m). MouseIcon = LoadResPicture ("x", vbResIcon)
Else 'sets mouse pointer to O for O first
Layer_A (m). MouseIcon = LoadResPicture ("o", vbResIcon)
Layer_A (m). FontSize = 28
Layer_A (m). FontBold = True
Layer_A (m). Caption = ""
Layer_A (m). BackStyle = 0
Layer_A (m). Alignment = 2
Layer_A (m). Enabled = False
Next m
'Update Status Bar
StatusBar1. SimpleText = "Select Game - New Game or Multiplayer option to start game"
Out_Box. Caption = "Start New Game."
Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
If onconnect = True Then
On Error GoTo NoDx
Call dpmsg. WriteLong (MSG_STOP)
Call CloseDownDPlay
Unload Connect
Unload MainBoard
Private Sub hostagame_Click ()
usermode = "host" 'Sets usermode to host
Connect. Show 'starts connect form
MainBoard. Enabled = False 'disable form so user cannot select while connect form is up
hostagame. Enabled = False 'disables menu host button.
joinagame. Enabled = False ' disables menu join button
multiplayermode = True 'sets multiplayer to true
Private Sub joinagame_Click ()
usermode = "client" 'Sets usermode to client
Connect. Show
MainBoard. Enabled = False
Страницы: 1, 2, 3, 4, 5
