Рефераты. Greating game on visual basic with multiplayer system

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

Страницы: 1, 2, 3, 4, 5



2012 © Все права защищены
При использовании материалов активная ссылка на источник обязательна.