46570 (565969)

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла

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

Player_A (u) = 0

Computer_A (u) = 0

Layer_A (u). Enabled = True

Next u

'update statusbar and display routine******************************

If usermode = "host" And multiplayermode = True Then

StatusBar1. SimpleText = "New Game Initialized " & profilename & "'s Turn"

Out_Box. Caption = profilename & "'s Turn."

End If

If usermode = "client" And multiplayermode = True Then

StatusBar1. SimpleText = "New Game Initialized " & opponentsname & "'s Turn"

Out_Box. Caption = opponentsname & "'s Turn."

End If

If multiplayermode = False Then

Out_Box. Caption = "X Goes First"

End If

End If

'End sw true*********************************************

'set starting icon*****************

If sw = False Then

StatusBar1. SimpleText = "New Game Initialized" & " O's Turn"

Debug. Print "Turn Status " & MyTurn

Debug. Print "SW Value is " & sw

u = 0

Sq_Left = 9

Token = 10

For u = 0 To 8

Layer_A (u). MousePointer = vbCustom

If usermode = "host" And multiplayermode = True Then

Layer_A (u). MouseIcon = LoadResPicture ("nyt", vbResIcon)

Else

Layer_A (u). MouseIcon = LoadResPicture ("o", 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

Player_A (u) = 0

Computer_A (u) = 0

Layer_A (u). Enabled = True

Next u

Temp = False 'initiate no win

'Update Statusbar and outbox display********************8

If usermode = "client" And multiplayermode = True Then

StatusBar1. SimpleText = "New Game Initialized " & profilename & "'s Turn"

Out_Box. Caption = profilename & " 's Turn."

End If

If usermode = "host" And multiplayermode = True Then

StatusBar1. SimpleText = "New Game Initialized " & opponentsname & "'s Turn"

Out_Box. Caption = opponentsname & " 's Turn."

End If

If multiplayermode = False Then

Out_Box. Caption = "O Goes First"

End If

Характеристики

Тип файла документ

Документы такого типа открываются такими программами, как Microsoft Office Word на компьютерах Windows, Apple Pages на компьютерах Mac, Open Office - бесплатная альтернатива на различных платформах, в том числе Linux. Наиболее простым и современным решением будут Google документы, так как открываются онлайн без скачивания прямо в браузере на любой платформе. Существуют российские качественные аналоги, например от Яндекса.

Будьте внимательны на мобильных устройствах, так как там используются упрощённый функционал даже в официальном приложении от Microsoft, поэтому для просмотра скачивайте PDF-версию. А если нужно редактировать файл, то используйте оригинальный файл.

Файлы такого типа обычно разбиты на страницы, а текст может быть форматированным (жирный, курсив, выбор шрифта, таблицы и т.п.), а также в него можно добавлять изображения. Формат идеально подходит для рефератов, докладов и РПЗ курсовых проектов, которые необходимо распечатать. Кстати перед печатью также сохраняйте файл в PDF, так как принтер может начудить со шрифтами.

Список файлов лабораторной работы