Greating game on visual basic with multiplayer system
2 AUTOMATIC SYSTEM GREATING GAME ON VISUAL BASIC WITH MULTIPLAYER SYSTEM Dushanbe, 2009 Main Interface Source Code Public lanchoice As Long 'address Public details As String 'names Public connected As Boolean 'if connected Private Sub Form_Load () Connect. Icon = LoadResPicture ("ictac", vbResIcon) 'form icon If usermode = "host" Then join. Enabled = False Else host. Enabled = False gamename. Visible = False Label5. Visible = False End If End Sub Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer) 'call on form cancel or exit by control box on form If connectionmade = False Then MainBoard. hostagame. Enabled = True MainBoard. joinagame. Enabled = True Call CloseDownDPlay multiplayermode = False End If MainBoard. Enabled = True End Sub Private Sub host_Click () On Error GoTo NO_Hosting ' error handler in case creating host fails If playersname = "" Or gamename = "" Then MsgBox "You must enter a Players name and Game Name", vbOKOnly, "Tic Tac Oops" Exit Sub End If Call goplay 'starts direct play object Dim address As DirectPlayAddress 'Selects which choice was made for lan Set address = EnumConnect. GetAddress (lanchoice) 'Binds address to directplay connection Call dxplay. InitializeConnection (address) 'Starts sessiondata information Dim SessionData As DirectPlaySessionData Set SessionData = dxplay. CreateSessionData Call SessionData. SetMaxPlayers (2) Call SessionData. SetSessionName (gamename. Text) Call SessionData. SetFlags (DPSESSION_MIGRATEHOST) Call SessionData. SetGuidApplication (AppGuid) 'Starts a new session initializes connection Call dxplay. Open (SessionData, DPOPEN_CREATE) 'Create Player profile Dim PlayerName As String Dim playerhandle As String PlayerName = playersname. Text profilename = PlayerName playerhandle = "Player (Host)" MyPlayer = dxplay. CreatePlayer (PlayerName, playerhandle, 0, 0) dxHost = True gameopen. Caption = gamename. Text Call updatedisplay 'Updates game list Label8. Caption = "Waiting for other Players" Exit Sub NO_Hosting: MsgBox "Could not Host Game", vbOKOnly, "Try Again" End Sub Private Sub join_Click () On Error GoTo Oops Call goplay Dim address As DirectPlayAddress Set address = EnumConnect. GetAddress (lanchoice) Call dxplay. InitializeConnection (address) Dim details2 As Byte Dim SessionData As DirectPlaySessionData Set SessionData = dxplay. CreateSessionData 'Gets Session any open session info Set EnumSession = dxplay. GetDPEnumSessions (SessionData, 0, DPENUMSESSIONS_AVAILABLE) Set SessionData = EnumSession. GetItem (1) 'Get open session name details = SessionData. GetSessionName If details > "" And usermode = "client" Then joingame. Enabled = True End If Call updatedisplay gameopen. Caption = details Exit Sub Oops: MsgBox "Connection Failed", vbOKOnly, "Tic Tac Oops" Exit Sub End Sub Public Function goplay () Set dxplay = dx7. DirectPlayCreate ("") 'open directplay object 'gets connection types Set EnumConnect = dxplay. GetDPEnumConnections ("", DPCONNECTION_DIRECTPLAY) End Function Private Sub joingame_Click () On Error GoTo Joinfailed If playersname = "" Then MsgBox "You must enter a Players name", vbOKOnly, "Tic Tac Oops" Exit Sub End If Dim SessionData As DirectPlaySessionData Set SessionData = EnumSession. GetItem (1) 'Joins open session Call dxplay. Open (SessionData, DPOPEN_JOIN) 'creats and sends player info PlayerName = playersname. Text profilename = PlayerName playerhandle = "Player (Client)" MyPlayer = dxplay. CreatePlayer (PlayerName, playerhandle, 0, 0) Call UpdateWaiting joingame. Enabled = False playersname. Enabled = False MainBoard. mnuchat. Enabled = True Exit Sub Joinfailed: MsgBox "Joining Session Failed", vbOKOnly, "No Session Found" Exit Sub End Sub Public Sub UpdateWaiting () Dim StatusMsg As String Dim x As Integer Dim objDPEnumPlayers As DirectPlayEnumPlayers Dim SessionData As DirectPlaySessionData ' Enumerate players On Error GoTo ENUMERROR Set objDPEnumPlayers = dxplay. GetDPEnumPlayers ("", 0) gNumPlayersWaiting = objDPEnumPlayers. GetCount ' Update label Set SessionData = dxplay. CreateSessionData Call dxplay. GetSessionDesc (SessionData) StatusMsg = gNumPlayersWaiting & " of " & SessionData. GetMaxPlayers _ & " players ready..." Label8. Caption = StatusMsg If gNumPlayersWaiting = SessionData. GetMaxPlayers And usermode = "host" Then start. Enabled = True Label8. Caption = "Everyone is here Click Start" End If If gNumPlayersWaiting = SessionData. GetMaxPlayers And usermode = "client" Then start. Enabled = False Label8. Caption = "Waiting For Host To Start Session" End If ' Update listbox Dim PlayerName As String For x = 1 To gNumPlayersWaiting PlayerName = objDPEnumPlayers. GetShortName (x) If PlayerName <> playersname. Text Then labeljoined. Caption = PlayerName & " has joined the game." opponentsname = PlayerName End If Call lstPlayers. AddItem (PlayerName) Next x Exit Sub ENUMERROR: MsgBox ("No Players Found") Exit Sub End Sub Private Sub lantype_Click (Index As Integer) lanchoice = Index + 1 host. Visible = True join. Visible = True End Sub Private Sub start_Click () On Error GoTo CouldNotStart Const msgsize = 21 Dim tnumplayers As DirectPlayEnumPlayers Dim SessionData As DirectPlaySessionData ' Disable joining, in case we start before maximum no. of players reached. We ' don't want anyone slipping in at the last moment. Set SessionData = dxplay. CreateSessionData Call dxplay. GetSessionDesc (SessionData) ' necessary? Call SessionData. SetFlags (SessionData. GetFlags + DPSESSION_JOINDISABLED) Call dxplay. SetSessionDesc (SessionData) ' Set global player count. This mustn't be done earlier, because someone might ' have dropped out or joined just as the host clicked Start. Set tnumplayers = dxplay. GetDPEnumPlayers ("", 0) numplayers = CByte (tnumplayers. GetCount) Dim dpmsg As DirectPlayMessage Dim pID As Long Dim msgtype As Long Dim x As Byte Set dpmsg = dxplay. CreateMessage dpmsg. WriteLong (MSG_STARTGAME) 'case selector dpmsg. WriteByte (numplayers) 'number of players Dim PlayerID As Long For x = 0 To numplayers - 1 PlayerID = tnumplayers. GetDPID (x + 1) dpmsg. WriteLong (PlayerID) ' Keep local copy of player IDs PlayerIDs (x) = PlayerID ' Assign place in order to the host If PlayerID = MyPlayer Then dxMyTurn = x Next x Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg) Hide MainBoard. Enabled = True MainBoard. Show MainBoard. playerdisplaylabel. Caption = opponentsname & " Has Joined The Game" MainBoard. StatusBar1. SimpleText = opponentsname & "Is Ready To Play, Start Game" MainBoard. mnudisconnect. Enabled = True connectionmade = True multiplayermode = True MainBoard. mnuchat. Enabled = True onconnect = True Exit Sub CouldNotStart: MsgBox "Could not start game. ", vbOKOnly, "System" End Sub 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 End If If multiplayermode = False Then MyTurn = True End If Begin = False ' cancel marking routine score = score + 1 'adds one to gamecount If multiplayermode = True Then If usermode = "client" And sw = True Then MyTurn = False ElseIf usermode = "client" And sw = False Then MyTurn = True End If End If 'Start SW true mode********************************** 'initialize game settings If sw = True Then 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) Else Layer_A (u). MouseIcon = LoadResPicture ("nyt", 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
Страницы: 1, 2, 3, 4
|