|
p align="left">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)
Страницы: 1, 2, 3, 4
| 
