p align="left">Player_A (u) = 0 Computer_A (u) = 0 Layer_A (u). Enabled = True Next u 'update statusbar and display routine****************************** If usermode = "host" And multiplayermode = True Then StatusBar1. SimpleText = "New Game Initialized " & profilename & "'s Turn" Out_Box. Caption = profilename & "'s Turn." End If If usermode = "client" And multiplayermode = True Then StatusBar1. SimpleText = "New Game Initialized " & opponentsname & "'s Turn" Out_Box. Caption = opponentsname & "'s Turn." End If If multiplayermode = False Then Out_Box. Caption = "X Goes First" End If End If 'End sw true********************************************* 'set starting icon***************** If sw = False Then StatusBar1. SimpleText = "New Game Initialized" & " O's Turn" Debug. Print "Turn Status " & MyTurn Debug. Print "SW Value is " & sw u = 0 Sq_Left = 9 Token = 10 For u = 0 To 8 Layer_A (u). MousePointer = vbCustom If usermode = "host" And multiplayermode = True Then Layer_A (u). MouseIcon = LoadResPicture ("nyt", vbResIcon) Else Layer_A (u). MouseIcon = LoadResPicture ("o", vbResIcon) End If 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 Temp = False 'initiate no win 'Update Statusbar and outbox display********************8 If usermode = "client" And multiplayermode = True Then StatusBar1. SimpleText = "New Game Initialized " & profilename & "'s Turn" Out_Box. Caption = profilename & " 's Turn." End If If usermode = "host" And multiplayermode = True Then StatusBar1. SimpleText = "New Game Initialized " & opponentsname & "'s Turn" Out_Box. Caption = opponentsname & " 's Turn." End If If multiplayermode = False Then Out_Box. Caption = "O Goes First" End If End If '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 End If 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" End End Sub 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" End End Sub 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) End If 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." End Sub Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer) If onconnect = True Then On Error GoTo NoDx Dim dpmsg As DirectPlayMessage Set dpmsg = dxplay. CreateMessage Call dpmsg. WriteLong (MSG_STOP) Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg) Call CloseDownDPlay End If Unload Connect Unload MainBoard End NoDx: MsgBox "Could not stop DXPlay. ", vbOKOnly, "System" End End Sub 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 End Sub Private Sub joinagame_Click () usermode = "client" 'Sets usermode to client Connect. Show MainBoard. Enabled = False 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
Страницы: 1, 2, 3, 4
|