home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / adx7mu1a / connect.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-10-10  |  13.4 KB  |  417 lines
  1. VERSION 5.00
  2. Begin VB.Form Connect 
  3.    Caption         =   "Connections"
  4.    ClientHeight    =   4740
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   7320
  8.    LinkTopic       =   "Form2"
  9.    ScaleHeight     =   4740
  10.    ScaleWidth      =   7320
  11.    StartUpPosition =   2  'CenterScreen
  12.    Begin VB.Frame Frame1 
  13.       Caption         =   "Connections"
  14.       Height          =   2655
  15.       Left            =   120
  16.       TabIndex        =   15
  17.       Top             =   120
  18.       Width           =   4095
  19.       Begin VB.CommandButton join 
  20.          Caption         =   "Find a Game"
  21.          Height          =   375
  22.          Left            =   240
  23.          TabIndex        =   4
  24.          Top             =   1560
  25.          Visible         =   0   'False
  26.          Width           =   1215
  27.       End
  28.       Begin VB.CommandButton host 
  29.          Caption         =   "Host"
  30.          Height          =   375
  31.          Left            =   240
  32.          TabIndex        =   3
  33.          Top             =   1080
  34.          Visible         =   0   'False
  35.          Width           =   1215
  36.       End
  37.       Begin VB.OptionButton lantype 
  38.          Caption         =   "Modem Play"
  39.          Height          =   495
  40.          Index           =   2
  41.          Left            =   1680
  42.          TabIndex        =   10
  43.          Top             =   1920
  44.          Width           =   1215
  45.       End
  46.       Begin VB.OptionButton lantype 
  47.          Caption         =   "IP/TCP or Internet"
  48.          Height          =   495
  49.          Index           =   1
  50.          Left            =   1680
  51.          TabIndex        =   9
  52.          Top             =   1440
  53.          Width           =   1935
  54.       End
  55.       Begin VB.OptionButton lantype 
  56.          Caption         =   "IPX Connection"
  57.          Height          =   495
  58.          Index           =   0
  59.          Left            =   1680
  60.          TabIndex        =   8
  61.          Top             =   960
  62.          Width           =   1815
  63.       End
  64.       Begin VB.Label Label1 
  65.          Alignment       =   2  'Center
  66.          Caption         =   "Select Connection Type and Establish a Conneciton"
  67.          BeginProperty Font 
  68.             Name            =   "MS Sans Serif"
  69.             Size            =   9.75
  70.             Charset         =   0
  71.             Weight          =   700
  72.             Underline       =   0   'False
  73.             Italic          =   0   'False
  74.             Strikethrough   =   0   'False
  75.          EndProperty
  76.          Height          =   615
  77.          Left            =   240
  78.          TabIndex        =   16
  79.          Top             =   240
  80.          Width           =   3015
  81.       End
  82.    End
  83.    Begin VB.ListBox lstPlayers 
  84.       Height          =   450
  85.       Left            =   4800
  86.       TabIndex        =   6
  87.       Top             =   3360
  88.       Width           =   1815
  89.    End
  90.    Begin VB.CommandButton start 
  91.       Caption         =   "start"
  92.       Enabled         =   0   'False
  93.       Height          =   375
  94.       Left            =   1680
  95.       TabIndex        =   5
  96.       Top             =   3480
  97.       Width           =   1335
  98.    End
  99.    Begin VB.TextBox playersname 
  100.       Height          =   285
  101.       Left            =   4680
  102.       TabIndex        =   0
  103.       Top             =   360
  104.       Width           =   2175
  105.    End
  106.    Begin VB.CommandButton joingame 
  107.       Caption         =   "joingame"
  108.       Enabled         =   0   'False
  109.       Height          =   375
  110.       Left            =   4920
  111.       TabIndex        =   7
  112.       Top             =   2400
  113.       Width           =   1575
  114.    End
  115.    Begin VB.TextBox gamename 
  116.       Height          =   285
  117.       Left            =   4680
  118.       TabIndex        =   1
  119.       Top             =   1080
  120.       Width           =   2175
  121.    End
  122.    Begin VB.Label labeljoined 
  123.       Alignment       =   2  'Center
  124.       BeginProperty Font 
  125.          Name            =   "MS Sans Serif"
  126.          Size            =   8.25
  127.          Charset         =   0
  128.          Weight          =   700
  129.          Underline       =   0   'False
  130.          Italic          =   -1  'True
  131.          Strikethrough   =   0   'False
  132.       EndProperty
  133.       ForeColor       =   &H00C00000&
  134.       Height          =   255
  135.       Left            =   1200
  136.       TabIndex        =   18
  137.       Top             =   4200
  138.       Width           =   4815
  139.    End
  140.    Begin VB.Label Label2 
  141.       Caption         =   "List of Connected Players"
  142.       Height          =   255
  143.       Left            =   4800
  144.       TabIndex        =   17
  145.       Top             =   3000
  146.       Width           =   1815
  147.    End
  148.    Begin VB.Label Label8 
  149.       Height          =   255
  150.       Left            =   120
  151.       TabIndex        =   14
  152.       Top             =   3000
  153.       Width           =   4095
  154.    End
  155.    Begin VB.Label label7 
  156.       Alignment       =   2  'Center
  157.       Caption         =   "Available Game"
  158.       Height          =   255
  159.       Left            =   4440
  160.       TabIndex        =   13
  161.       Top             =   1560
  162.       Visible         =   0   'False
  163.       Width           =   2535
  164.    End
  165.    Begin VB.Label Label6 
  166.       Caption         =   "Your Name"
  167.       Height          =   255
  168.       Left            =   4680
  169.       TabIndex        =   12
  170.       Top             =   120
  171.       Width           =   2175
  172.    End
  173.    Begin VB.Label Label5 
  174.       Caption         =   "Game Name"
  175.       Height          =   255
  176.       Left            =   4680
  177.       TabIndex        =   11
  178.       Top             =   840
  179.       Width           =   2175
  180.    End
  181.    Begin VB.Label gameopen 
  182.       Alignment       =   2  'Center
  183.       Caption         =   "No Games Available"
  184.       BeginProperty Font 
  185.          Name            =   "MS Sans Serif"
  186.          Size            =   12
  187.          Charset         =   0
  188.          Weight          =   700
  189.          Underline       =   -1  'True
  190.          Italic          =   0   'False
  191.          Strikethrough   =   0   'False
  192.       EndProperty
  193.       ForeColor       =   &H000000FF&
  194.       Height          =   375
  195.       Left            =   4200
  196.       TabIndex        =   2
  197.       Top             =   1920
  198.       Width           =   3015
  199.    End
  200. Attribute VB_Name = "Connect"
  201. Attribute VB_GlobalNameSpace = False
  202. Attribute VB_Creatable = False
  203. Attribute VB_PredeclaredId = True
  204. Attribute VB_Exposed = False
  205. Public lanchoice As Long 'address
  206. Public details As String 'names
  207. Public connected As Boolean 'if connected
  208. Private Sub Form_Load()
  209. Connect.Icon = LoadResPicture("ictac", vbResIcon) 'form icon
  210. If usermode = "host" Then
  211. join.Enabled = False
  212. host.Enabled = False
  213. gamename.Visible = False
  214. Label5.Visible = False
  215. End If
  216. End Sub
  217. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  218. 'call on form cancel or exit by control box on form
  219. If connectionmade = False Then
  220. MainBoard.hostagame.Enabled = True
  221. MainBoard.joinagame.Enabled = True
  222. Call CloseDownDPlay
  223. multiplayermode = False
  224. End If
  225. MainBoard.Enabled = True
  226. End Sub
  227. Private Sub host_Click()
  228. On Error GoTo NO_Hosting ' error handler in case creating host fails
  229. If playersname = "" Or gamename = "" Then
  230. MsgBox "You must enter a Players name and Game Name", vbOKOnly, "Tic Tac Oops"
  231. Exit Sub
  232. End If
  233. Call goplay 'starts direct play object
  234. Dim address As DirectPlayAddress
  235. 'Selects which choice was made for lan
  236. Set address = EnumConnect.GetAddress(lanchoice)
  237. 'Binds address to directplay connection
  238. Call dxplay.InitializeConnection(address)
  239. 'Starts sessiondata information
  240. Dim SessionData As DirectPlaySessionData
  241. Set SessionData = dxplay.CreateSessionData
  242. Call SessionData.SetMaxPlayers(2)
  243. Call SessionData.SetSessionName(gamename.Text)
  244. Call SessionData.SetFlags(DPSESSION_MIGRATEHOST)
  245. Call SessionData.SetGuidApplication(AppGuid)
  246. 'Starts a new session initializes connection
  247. Call dxplay.Open(SessionData, DPOPEN_CREATE)
  248. 'Create Player profile
  249. Dim PlayerName As String
  250. Dim playerhandle As String
  251. PlayerName = playersname.Text
  252. profilename = PlayerName
  253. playerhandle = "Player(Host)"
  254. MyPlayer = dxplay.CreatePlayer(PlayerName, playerhandle, 0, 0)
  255. dxHost = True
  256. gameopen.Caption = gamename.Text
  257. Call updatedisplay 'Updates game list
  258. Label8.Caption = "Waiting for other Players"
  259. Exit Sub
  260. NO_Hosting:
  261.     MsgBox "Could not Host Game", vbOKOnly, "Try Again"
  262. End Sub
  263. Private Sub join_Click()
  264. On Error GoTo Oops
  265. Call goplay
  266. Dim address As DirectPlayAddress
  267. Set address = EnumConnect.GetAddress(lanchoice)
  268. Call dxplay.InitializeConnection(address)
  269. Dim details2 As Byte
  270. Dim SessionData As DirectPlaySessionData
  271. Set SessionData = dxplay.CreateSessionData
  272. 'Gets Session any open session info
  273. Set EnumSession = dxplay.GetDPEnumSessions(SessionData, 0, DPENUMSESSIONS_AVAILABLE)
  274. Set SessionData = EnumSession.GetItem(1)
  275. 'Get open session name
  276. details = SessionData.GetSessionName
  277. If details > "" And usermode = "client" Then
  278. joingame.Enabled = True
  279. End If
  280. Call updatedisplay
  281. gameopen.Caption = details
  282. Exit Sub
  283. Oops:
  284.     MsgBox "Connection Failed", vbOKOnly, "Tic Tac Oops"
  285.     Exit Sub
  286. End Sub
  287. Public Function goplay()
  288. Set dxplay = dx7.DirectPlayCreate("") 'open directplay object
  289. 'gets connection types
  290. Set EnumConnect = dxplay.GetDPEnumConnections("", DPCONNECTION_DIRECTPLAY)
  291. End Function
  292. Private Sub joingame_Click()
  293. On Error GoTo Joinfailed
  294. If playersname = "" Then
  295. MsgBox "You must enter a Players name", vbOKOnly, "Tic Tac Oops"
  296. Exit Sub
  297. End If
  298. Dim SessionData As DirectPlaySessionData
  299. Set SessionData = EnumSession.GetItem(1)
  300. 'Joins open session
  301. Call dxplay.Open(SessionData, DPOPEN_JOIN)
  302. 'creats and sends player info
  303. PlayerName = playersname.Text
  304. profilename = PlayerName
  305. playerhandle = "Player(Client)"
  306. MyPlayer = dxplay.CreatePlayer(PlayerName, playerhandle, 0, 0)
  307. Call UpdateWaiting
  308. joingame.Enabled = False
  309. playersname.Enabled = False
  310. MainBoard.mnuchat.Enabled = True
  311. Exit Sub
  312. Joinfailed:
  313.     MsgBox "Joining Session Failed", vbOKOnly, "No Session Found"
  314.     Exit Sub
  315. End Sub
  316. Public Sub UpdateWaiting()
  317.   Dim StatusMsg As String
  318.   Dim x As Integer
  319.   Dim objDPEnumPlayers As DirectPlayEnumPlayers
  320.   Dim SessionData As DirectPlaySessionData
  321.   ' Enumerate players
  322.   On Error GoTo ENUMERROR
  323.   Set objDPEnumPlayers = dxplay.GetDPEnumPlayers("", 0)
  324.   gNumPlayersWaiting = objDPEnumPlayers.GetCount
  325.   ' Update label
  326.   Set SessionData = dxplay.CreateSessionData
  327.   Call dxplay.GetSessionDesc(SessionData)
  328.   StatusMsg = gNumPlayersWaiting & " of " & SessionData.GetMaxPlayers _
  329.           & " players ready..."
  330.   Label8.Caption = StatusMsg
  331.      If gNumPlayersWaiting = SessionData.GetMaxPlayers And usermode = "host" Then
  332.         start.Enabled = True
  333.         Label8.Caption = "Everyone is here Click Start"
  334.         End If
  335.        If gNumPlayersWaiting = SessionData.GetMaxPlayers And usermode = "client" Then
  336.         start.Enabled = False
  337.         Label8.Caption = "Waiting For Host To Start Session"
  338.         End If
  339.   ' Update listbox
  340.   Dim PlayerName As String
  341.   For x = 1 To gNumPlayersWaiting
  342.     PlayerName = objDPEnumPlayers.GetShortName(x)
  343.     If PlayerName <> playersname.Text Then
  344.         labeljoined.Caption = PlayerName & " has joined the game."
  345.         opponentsname = PlayerName
  346.     End If
  347.     Call lstPlayers.AddItem(PlayerName)
  348.   Next x
  349.   Exit Sub
  350. ENUMERROR:
  351.   MsgBox ("No Players Found")
  352.   Exit Sub
  353. End Sub
  354. Private Sub lantype_Click(Index As Integer)
  355. lanchoice = Index + 1
  356. host.Visible = True
  357. join.Visible = True
  358. End Sub
  359. Private Sub start_Click()
  360. On Error GoTo CouldNotStart
  361. Const msgsize = 21
  362. Dim tnumplayers As DirectPlayEnumPlayers
  363. Dim SessionData As DirectPlaySessionData
  364.   ' Disable joining, in case we start before maximum no. of players reached. We
  365.   ' don't want anyone slipping in at the last moment.
  366.   Set SessionData = dxplay.CreateSessionData
  367.   Call dxplay.GetSessionDesc(SessionData)    ' necessary?
  368.   Call SessionData.SetFlags(SessionData.GetFlags + DPSESSION_JOINDISABLED)
  369.   Call dxplay.SetSessionDesc(SessionData)
  370.   ' Set global player count. This mustn't be done earlier, because someone might
  371.   ' have dropped out or joined just as the host clicked Start.
  372. Set tnumplayers = dxplay.GetDPEnumPlayers("", 0)
  373.   numplayers = CByte(tnumplayers.GetCount)
  374. Dim dpmsg As DirectPlayMessage
  375. Dim pID As Long
  376. Dim msgtype As Long
  377. Dim x As Byte
  378.         Set dpmsg = dxplay.CreateMessage
  379.         dpmsg.WriteLong (MSG_STARTGAME) 'case selector
  380.         dpmsg.WriteByte (numplayers) 'number of players
  381.         Dim PlayerID As Long
  382. For x = 0 To numplayers - 1
  383.     PlayerID = tnumplayers.GetDPID(x + 1)
  384.     dpmsg.WriteLong (PlayerID)
  385.     ' Keep local copy of player IDs
  386.     PlayerIDs(x) = PlayerID
  387.     ' Assign place in order to the host
  388.     If PlayerID = MyPlayer Then dxMyTurn = x
  389.   Next x
  390. Call dxplay.Send(MyPlayer, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpmsg)
  391.     Hide
  392.     MainBoard.Enabled = True
  393.         MainBoard.Show
  394.         MainBoard.playerdisplaylabel.Caption = opponentsname & " Has Joined The Game"
  395.         MainBoard.StatusBar1.SimpleText = opponentsname & "Is Ready To Play,  Start Game"
  396.         MainBoard.mnudisconnect.Enabled = True
  397.         connectionmade = True
  398.         multiplayermode = True
  399.         MainBoard.mnuchat.Enabled = True
  400.         onconnect = True
  401.         Exit Sub
  402. CouldNotStart:
  403.     MsgBox "Could not start game.", vbOKOnly, "System"
  404. End Sub
  405. Private Function updatedisplay()
  406. label7.Visible = True
  407. gameopen.FontUnderline = False
  408. gameopen.ForeColor = vbBlue
  409. host.Enabled = False
  410. join.Enabled = False
  411. Dim Y As Byte
  412. Y = 0
  413. For Y = 0 To 2 Step 1
  414.  lantype(Y).Enabled = False
  415.       Next Y
  416. End Function
  417.