home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectPlay / SimpleClient / frmClient.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  8.9 KB  |  211 lines
  1. VERSION 5.00
  2. Begin VB.Form frmClient 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "vbSimple Client"
  5.    ClientHeight    =   4470
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5400
  9.    Icon            =   "frmClient.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4470
  14.    ScaleWidth      =   5400
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.Frame Rules 
  17.       Caption         =   "Rules"
  18.       Height          =   855
  19.       Left            =   60
  20.       TabIndex        =   6
  21.       Top             =   120
  22.       Width           =   5295
  23.       Begin VB.Label Label1 
  24.          BackStyle       =   0  'Transparent
  25.          Caption         =   $"frmClient.frx":0442
  26.          Height          =   615
  27.          Index           =   1
  28.          Left            =   60
  29.          TabIndex        =   7
  30.          Top             =   180
  31.          Width           =   5055
  32.       End
  33.    End
  34.    Begin VB.CommandButton cmdExit 
  35.       Cancel          =   -1  'True
  36.       Caption         =   "Exit"
  37.       Height          =   375
  38.       Left            =   3143
  39.       TabIndex        =   5
  40.       Top             =   4020
  41.       Width           =   1215
  42.    End
  43.    Begin VB.CommandButton cmdFace 
  44.       Caption         =   "Make Faces"
  45.       Default         =   -1  'True
  46.       Height          =   375
  47.       Left            =   1043
  48.       TabIndex        =   4
  49.       Top             =   4020
  50.       Width           =   1215
  51.    End
  52.    Begin VB.TextBox txtUserInfo 
  53.       BackColor       =   &H8000000F&
  54.       Height          =   1935
  55.       Left            =   60
  56.       Locked          =   -1  'True
  57.       MultiLine       =   -1  'True
  58.       ScrollBars      =   2  'Vertical
  59.       TabIndex        =   1
  60.       Top             =   1980
  61.       Width           =   5295
  62.    End
  63.    Begin VB.Frame Frame1 
  64.       Caption         =   "User Stats"
  65.       Height          =   915
  66.       Left            =   60
  67.       TabIndex        =   0
  68.       Top             =   1020
  69.       Width           =   5235
  70.       Begin VB.Label lblSession 
  71.          BackStyle       =   0  'Transparent
  72.          Height          =   255
  73.          Left            =   120
  74.          TabIndex        =   3
  75.          Top             =   240
  76.          Width           =   4935
  77.       End
  78.       Begin VB.Label lblStats 
  79.          BackStyle       =   0  'Transparent
  80.          Height          =   255
  81.          Left            =   120
  82.          TabIndex        =   2
  83.          Top             =   540
  84.          Width           =   4995
  85.       End
  86.    End
  87. Attribute VB_Name = "frmClient"
  88. Attribute VB_GlobalNameSpace = False
  89. Attribute VB_Creatable = False
  90. Attribute VB_PredeclaredId = True
  91. Attribute VB_Exposed = False
  92. Option Explicit
  93. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  94. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  95. '  File:       frmClient.frm
  96. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  97. Implements DirectPlay8Event
  98. Private Enum MsgTypes
  99.     Msg_NoOtherPlayers
  100.     Msg_NumPlayers
  101.     Msg_SendWave
  102. End Enum
  103. Private Sub cmdExit_Click()
  104.     Unload Me
  105. End Sub
  106. Private Sub cmdFace_Click()
  107.     'Now we just need to 'make faces'
  108.     Dim oMsg() As Byte, lOffset As Long
  109.     lOffset = NewBuffer(oMsg)
  110.     AddDataToBuffer oMsg, CByte(1), SIZE_BYTE, lOffset
  111.     dpc.Send oMsg, 0, DPNSEND_NOLOOPBACK
  112. End Sub
  113. Private Sub Form_Load()
  114.         
  115.     Set DPlayEventsForm = New DPlayConnect
  116.     'First lets get the dplay connection started
  117.     If Not DPlayEventsForm.StartClientConnectWizard(dx, dpc, AppGuid, 10, Me) Then
  118.         Cleanup
  119.         End
  120.     End If
  121. End Sub
  122. Private Sub Form_Unload(Cancel As Integer)
  123.     Me.Hide
  124.     DPlayEventsForm.DoSleep 50
  125.     Cleanup
  126. End Sub
  127. Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
  128.     'VB requires that we must implement *every* member of this interface
  129. End Sub
  130. Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
  131.     'VB requires that we must implement *every* member of this interface
  132. End Sub
  133. Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
  134.     'VB requires that we must implement *every* member of this interface
  135. End Sub
  136. Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
  137.     Dim AppDesc As DPN_APPLICATION_DESC
  138.     If dpnotify.hResultCode <> 0 Then
  139.         'For some reason we could not connect.  All available slots must be closed.
  140.         MsgBox "Connect Failed.  Error: 0x" & CStr(Hex$(dpnotify.hResultCode)) & "  - This sample will now close.", vbOKOnly Or vbCritical, "Closing"
  141.         DPlayEventsForm.CloseForm Me
  142.     Else
  143.         AppDesc = dpc.GetApplicationDesc(0)
  144.         Me.Caption = AppDesc.SessionName
  145.         lblSession = "Session Name: " & AppDesc.SessionName
  146.         lblStats.Caption = "Total clients: " & CStr(AppDesc.lCurrentPlayers) & "/" & CStr(AppDesc.lMaxPlayers)
  147.     End If
  148. End Sub
  149. Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
  150.     'VB requires that we must implement *every* member of this interface
  151. End Sub
  152. Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
  153.     'VB requires that we must implement *every* member of this interface
  154. End Sub
  155. Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  156.     'VB requires that we must implement *every* member of this interface
  157. End Sub
  158. Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  159.     'VB requires that we must implement *every* member of this interface
  160. End Sub
  161. Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
  162.     'VB requires that we must implement *every* member of this interface
  163. End Sub
  164. Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
  165.     'VB requires that we must implement *every* member of this interface
  166. End Sub
  167. Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
  168.     'VB requires that we must implement *every* member of this interface
  169. End Sub
  170. Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
  171.     'VB requires that we must implement *every* member of this interface
  172. End Sub
  173. Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
  174.     'VB requires that we must implement *every* member of this interface
  175. End Sub
  176. Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
  177.     'VB requires that we must implement *every* member of this interface
  178. End Sub
  179. Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
  180.     'The server is telling us something.  What?
  181.     Dim sPlayer As String, lOffset As Long
  182.     Dim lMsg As Long, lNum As Long, lMax As Long
  183.     GetDataFromBuffer dpnotify.ReceivedData, lMsg, LenB(lMsg), lOffset
  184.     Select Case lMsg
  185.     Case Msg_NumPlayers
  186.         GetDataFromBuffer dpnotify.ReceivedData, lNum, LenB(lNum), lOffset
  187.         GetDataFromBuffer dpnotify.ReceivedData, lMax, LenB(lMax), lOffset
  188.         lblStats.Caption = "Total clients: " & CStr(lNum) & "/" & CStr(lMax)
  189.     Case Msg_NoOtherPlayers
  190.         txtUserInfo.Text = txtUserInfo.Text & "There are no other players to make funny faces at!" & vbCrLf
  191.         txtUserInfo.SelStart = Len(txtUserInfo.Text)
  192.     Case Msg_SendWave
  193.         'The only data we will receive is player info
  194.         sPlayer = GetStringFromBuffer(dpnotify.ReceivedData, lOffset)
  195.         'Append the data to the end of the line, and autoscroll there
  196.         txtUserInfo.Text = txtUserInfo.Text & sPlayer & " is making faces at you!" & vbCrLf
  197.         txtUserInfo.SelStart = Len(txtUserInfo.Text)
  198.     End Select
  199. End Sub
  200. Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
  201.     'VB requires that we must implement *every* member of this interface
  202. End Sub
  203. Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
  204.     If dpnotify.hResultCode = DPNERR_HOSTTERMINATEDSESSION Then
  205.         MsgBox "The host has terminated this session.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
  206.     Else
  207.         MsgBox "This session has been lost.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
  208.     End If
  209.     DPlayEventsForm.CloseForm Me
  210. End Sub
  211.