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
MainBoard. Enabled = True
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
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"
NO_Hosting:
MsgBox "Could not Host Game", vbOKOnly, "Try Again"
Private Sub join_Click ()
On Error GoTo Oops
Call goplay
Dim details2 As Byte
'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
Call updatedisplay
gameopen. Caption = details
Oops:
MsgBox "Connection Failed", vbOKOnly, "Tic Tac Oops"
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"
'Joins open session
Call dxplay. Open (SessionData, DPOPEN_JOIN)
'creats and sends player info
playerhandle = "Player (Client)"
Call UpdateWaiting
joingame. Enabled = False
playersname. Enabled = False
MainBoard. mnuchat. Enabled = True
Joinfailed:
MsgBox "Joining Session Failed", vbOKOnly, "No Session Found"
Public Sub UpdateWaiting ()
Dim StatusMsg As String
Dim x As Integer
Dim objDPEnumPlayers As DirectPlayEnumPlayers
' Enumerate players
On Error GoTo ENUMERROR
Set objDPEnumPlayers = dxplay. GetDPEnumPlayers ("", 0)
gNumPlayersWaiting = objDPEnumPlayers. GetCount
' Update label
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"
If gNumPlayersWaiting = SessionData. GetMaxPlayers And usermode = "client" Then
start. Enabled = False
Label8. Caption = "Waiting For Host To Start Session"
' Update listbox
For x = 1 To gNumPlayersWaiting
PlayerName = objDPEnumPlayers. GetShortName (x)
If PlayerName <> playersname. Text Then
labeljoined. Caption = PlayerName & " has joined the game."
opponentsname = PlayerName
Call lstPlayers. AddItem (PlayerName)
Next x
ENUMERROR:
MsgBox ("No Players Found")
Private Sub lantype_Click (Index As Integer)
lanchoice = Index + 1
host. Visible = True
join. Visible = True
Private Sub start_Click ()
On Error GoTo CouldNotStart
Const msgsize = 21
Dim tnumplayers As DirectPlayEnumPlayers
' Disable joining, in case we start before maximum no. of players reached. We
' don't want anyone slipping in at the last moment.
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
Call dxplay. Send (MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg)
Hide
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
onconnect = True
CouldNotStart:
MsgBox "Could not start game. ", vbOKOnly, "System"
Страницы: 1, 2, 3, 4, 5