46570 (Greating game on visual basic with multiplayer system), страница 2

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

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