Initial commit: ROW Client source code

Game client codebase including:
- CharacterActionControl: Character and creature management
- GlobalScript: Network, items, skills, quests, utilities
- RYLClient: Main client application with GUI and event handlers
- Engine: 3D rendering engine (RYLGL)
- MemoryManager: Custom memory allocation
- Library: Third-party dependencies (DirectX, boost, etc.)
- Tools: Development utilities

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
2025-11-29 16:24:34 +09:00
commit e067522598
5135 changed files with 1745744 additions and 0 deletions

View File

@@ -0,0 +1,96 @@
Attribute VB_Name = "DplayModule"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: dplay.bas
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Enum DPLAY_MSGS
MSG_CHANGEGROUP
MSG_CHANGETALK
MSG_SERVERCHANGEGROUP
End Enum
'Constants
Public Const AppGuid = "{F5230441-9B71-88DA-998C-00207547A14D}"
'DirectX Variables
Public dvServer As DirectPlayVoiceServer8
Public dvClient As DirectPlayVoiceClient8
Public dx As DirectX8
Public dpp As DirectPlay8Peer
Public oSession As DVSESSIONDESC
Public oSound As DVSOUNDDEVICECONFIG
Public oClient As DVCLIENTCONFIG
Public glGroupID(1 To 5) As Long
'Misc Vars
Public glMyPlayerID As Long
Public fGotSettings As Boolean
Public DPlayEventsForm As DPlayConnect
Public Sub InitDPlay()
Set dx = New DirectX8
Set dpp = dx.DirectPlayPeerCreate
Set dvServer = dx.DirectPlayVoiceServerCreate
Set dvClient = dx.DirectPlayVoiceClientCreate
End Sub
Public Sub Cleanup()
On Error Resume Next
'Turn off our error handling
If Not (DPlayEventsForm Is Nothing) Then
If Not (dpp Is Nothing) Then dpp.UnRegisterMessageHandler
If Not (dvClient Is Nothing) Then dvClient.UnRegisterMessageHandler
If Not (dvServer Is Nothing) Then dvServer.UnRegisterMessageHandler
dvClient.Disconnect 0
DPlayEventsForm.DoSleep 50
If DPlayEventsForm.IsHost Then dvServer.StopSession 0
If Not dpp Is Nothing Then dpp.Close
DPlayEventsForm.GoUnload
'Destroy the objects
Set dvClient = Nothing
Set dvServer = Nothing
Set dpp = Nothing
Set dx = Nothing
End If
End Sub
Private Sub Main()
'Here is where we will start
InitDPlay
Set DPlayEventsForm = New DPlayConnect
If Not DPlayEventsForm.StartConnectWizard(dx, dpp, AppGuid, 20) Then
Cleanup
Else 'We did choose to play a game
If Not (DPlayEventsForm.IsHost) Then frmVoiceSettings.ClientOnly
frmVoiceSettings.Show vbModal
If Not fGotSettings Then 'We quit for some unknown reason.
Cleanup
Exit Sub
End If
frmVoice.Show vbModeless
If DPlayEventsForm.IsHost Then frmVoice.Caption = frmVoice.Caption & " (HOST)"
End If
End Sub
Public Sub RemovePlayerFromAllGroups(lPlayerID As Long)
On Error Resume Next 'We don't care about any errors..
Dim lCount As Long
For lCount = 1 To 5
dpp.RemovePlayerFromGroup glGroupID(lCount), lPlayerID, 0
Next
Err.Clear
'Ignore the errors about Player not in group
End Sub

View File

@@ -0,0 +1,561 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmVoice
BorderStyle = 3 'Fixed Dialog
Caption = "DirectPlay Voice Sample"
ClientHeight = 3285
ClientLeft = 45
ClientTop = 330
ClientWidth = 5985
Icon = "frmVoice.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3285
ScaleWidth = 5985
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdClient
Caption = "Settings"
Default = -1 'True
Height = 375
Left = 4680
TabIndex = 7
Top = 300
Width = 1215
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Exit"
Height = 375
Left = 4680
TabIndex = 6
Top = 780
Width = 1215
End
Begin VB.ComboBox cboTalkingGroup
Height = 315
ItemData = "frmVoice.frx":0442
Left = 1980
List = "frmVoice.frx":0458
Style = 2 'Dropdown List
TabIndex = 5
Top = 2880
Width = 2595
End
Begin VB.ComboBox cboMyGroup
Height = 315
ItemData = "frmVoice.frx":0498
Left = 1980
List = "frmVoice.frx":04AE
Style = 2 'Dropdown List
TabIndex = 3
Top = 2520
Width = 2595
End
Begin MSComctlLib.ListView lvMembers
Height = 2175
Left = 60
TabIndex = 1
Top = 300
Width = 4515
_ExtentX = 7964
_ExtentY = 3836
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Name"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Status"
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Group"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Target"
Object.Width = 1764
EndProperty
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "I'm talking to this group:"
Height = 255
Index = 2
Left = 60
TabIndex = 4
Top = 2940
Width = 1815
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "I'm currently in the group:"
Height = 255
Index = 1
Left = 60
TabIndex = 2
Top = 2580
Width = 1815
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Members of this conversation:"
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 60
Width = 3855
End
End
Attribute VB_Name = "frmVoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: frmVoice.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Implements DirectPlayVoiceEvent8
Implements DirectPlay8Event
Private Sub UpdateList(ByVal lPlayerID As Long, fTalking As Boolean)
Dim lCount As Long
For lCount = lvMembers.ListItems.Count To 1 Step -1
If lvMembers.ListItems.Item(lCount).Key = "K" & CStr(lPlayerID) Then
'Change this guys status
If fTalking Then
lvMembers.ListItems.Item(lCount).SubItems(1) = "Talking"
Else
lvMembers.ListItems.Item(lCount).SubItems(1) = "Silent"
End If
End If
Next
End Sub
Private Sub cboMyGroup_Click()
On Error Resume Next
Dim lMsg As Long, lOffset As Long
Dim oBuf() As Byte
'Ok, I don't want to be in this group anymore.. let's change..
UpdateGroup glMyPlayerID, cboMyGroup.ListIndex
'Now send a message to everyone telling them
If DPlayEventsForm.IsHost Then
If cboMyGroup.ListIndex = 0 Then
RemovePlayerFromAllGroups glMyPlayerID
Else
RemovePlayerFromAllGroups glMyPlayerID
'Add myself to the new group
dpp.AddPlayerToGroup glGroupID(cboMyGroup.ListIndex), glMyPlayerID, 0
End If
Else
lMsg = MSG_SERVERCHANGEGROUP
lOffset = NewBuffer(oBuf)
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
AddDataToBuffer oBuf, CLng(cboMyGroup.ListIndex), SIZE_LONG, lOffset
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_GUARANTEED Or DPNSEND_NOLOOPBACK
End If
lMsg = MSG_CHANGEGROUP
lOffset = NewBuffer(oBuf)
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
AddDataToBuffer oBuf, CLng(cboMyGroup.ListIndex), SIZE_LONG, lOffset
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_GUARANTEED Or DPNSEND_NOLOOPBACK
End Sub
Private Sub cboTalkingGroup_Click()
Dim lMsg As Long, lOffset As Long
Dim oBuf() As Byte
Dim lTargets(0) As Long
'Who do I want to talk to?
If cboTalkingGroup.ListIndex = 0 Then 'Talk to everyone
lTargets(0) = DVID_ALLPLAYERS
dvClient.SetTransmitTargets lTargets, 0
Else
If DPlayEventsForm.IsHost Then
lTargets(0) = glGroupID(cboTalkingGroup.ListIndex)
Else
lTargets(0) = GetGroupID(cboTalkingGroup.ListIndex)
End If
dvClient.SetTransmitTargets lTargets, 0
End If
UpdateTarget glMyPlayerID, cboTalkingGroup.ListIndex
'Now send a message to everyone telling them
lMsg = MSG_CHANGETALK
lOffset = NewBuffer(oBuf)
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
AddDataToBuffer oBuf, CLng(cboTalkingGroup.ListIndex), SIZE_LONG, lOffset
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_GUARANTEED Or DPNSEND_NOLOOPBACK
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdClient_Click()
'Show the settings screen, and re-adjust them
frmVoiceSettings.Show vbModal
dvClient.SetClientConfig oClient
End Sub
Private Sub Form_Load()
Dim dpGroupInfo As DPN_GROUP_INFO
Dim lCount As Long
DPlayEventsForm.RegisterCallback Me
'First let's set up the DirectPlayVoice stuff since that's the point of this demo
If DPlayEventsForm.IsHost Then
'After we've created (and opened) the session and got the first player, let's start
'the DplayVoice server
If (dvServer Is Nothing) Then Set dvServer = dx.DirectPlayVoiceServerCreate
dvServer.Initialize dpp, 0
dvServer.StartSession oSession, 0
End If
'Now create a client as well (so we can both talk and listen)
Set dvClient = dx.DirectPlayVoiceClientCreate
'Now let's create a client event..
dvClient.StartClientNotification Me
dvClient.Initialize dpp, 0
oSound.hwndAppWindow = Me.hwnd
On Error Resume Next
dvClient.Connect oSound, oClient, 0
If Err.Number = DVERR_RUN_SETUP Then 'The audio tests have not been run on this
'machine. Run them now.
'we need to run setup first
Dim dvSetup As DirectPlayVoiceTest8
Set dvSetup = dx.DirectPlayVoiceTestCreate
dvSetup.CheckAudioSetup vbNullString, vbNullString, Me.hwnd, 0 'Check the default devices since that's what we'll be using
If Err.Number = DVERR_COMMANDALREADYPENDING Then
MsgBox "Could not start DirectPlayVoice. The Voice Networking wizard is already open. This sample must exit.", vbOKOnly Or vbInformation, "No Voice"
Cleanup
Unload Me
End
End If
If Err.Number = DVERR_USERCANCEL Then
MsgBox "Could not start DirectPlayVoice. The Voice Networking wizard has been cancelled. This sample must exit.", vbOKOnly Or vbInformation, "No Voice"
Cleanup
Unload Me
End
End If
Set dvSetup = Nothing
dvClient.Connect oSound, oClient, 0
ElseIf Err.Number <> 0 And Err.Number <> DVERR_PENDING Then
MsgBox "Could not start DirectPlayVoice. This sample must exit." & vbCrLf & "Error:" & CStr(Err.Number), vbOKOnly Or vbCritical, "Exiting"
Cleanup
Unload Me
End
End If
'We need to create our 5 groups
For lCount = 1 To 5
With dpGroupInfo
.lInfoFlags = DPNINFO_NAME
.Name = "Group" & CStr(lCount)
End With
dpp.CreateGroup dpGroupInfo, 0
Next
cboMyGroup.ListIndex = 0
cboTalkingGroup.ListIndex = 0
UpdatePlayerList
End Sub
Public Sub AddPlayer(ByVal lPlayerID As Long, ByVal sName As String)
Dim lItem As ListItem
Set lItem = lvMembers.ListItems.Add(, "K" & CStr(lPlayerID), sName)
lItem.SubItems(1) = "Silent"
lItem.SubItems(2) = cboMyGroup.List(0)
lItem.SubItems(3) = cboTalkingGroup.List(0)
End Sub
Public Sub RemovePlayer(ByVal lPlayerID As Long)
Dim lCount As Long
For lCount = lvMembers.ListItems.Count To 1 Step -1
If lvMembers.ListItems.Item(lCount).Key = "K" & CStr(lPlayerID) Then
'Remove this one
lvMembers.ListItems.Remove lCount
End If
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Hide
DPlayEventsForm.DoSleep 50
Cleanup
End Sub
Public Sub UpdateTarget(ByVal lPlayerID As Long, ByVal lIndex As Long)
Dim lCount As Long
For lCount = lvMembers.ListItems.Count To 1 Step -1
If lvMembers.ListItems.Item(lCount).Key = "K" & CStr(lPlayerID) Then
'Change my group
lvMembers.ListItems.Item(lCount).SubItems(3) = cboTalkingGroup.List(lIndex)
End If
Next
End Sub
Public Sub UpdateGroup(ByVal lPlayerID As Long, ByVal lIndex As Long)
Dim lCount As Long
For lCount = lvMembers.ListItems.Count To 1 Step -1
If lvMembers.ListItems.Item(lCount).Key = "K" & CStr(lPlayerID) Then
'Change my group
lvMembers.ListItems.Item(lCount).SubItems(2) = cboMyGroup.List(lIndex)
End If
Next
End Sub
Private Function AmIInList(ByVal lPlayerID As Long) As Boolean
Dim lCount As Long, fInThis As Boolean
For lCount = lvMembers.ListItems.Count To 1 Step -1
If lvMembers.ListItems.Item(lCount).Key = "K" & CStr(lPlayerID) Then
fInThis = True
End If
Next
AmIInList = fInThis
End Function
Private Sub UpdatePlayerList()
'Get everyone who is currently in the session and add them if we don't have them currently.
Dim lCount As Long
Dim Player As DPN_PLAYER_INFO
' Enumerate players
For lCount = 1 To dpp.GetCountPlayersAndGroups(DPNENUM_PLAYERS)
If Not (AmIInList(dpp.GetPlayerOrGroup(lCount))) Then 'Add this player
Dim lItem As ListItem, sName As String
Player = dpp.GetPeerInfo(dpp.GetPlayerOrGroup(lCount))
sName = Player.Name
If sName = vbNullString Then sName = "Unknown"
If (Player.lPlayerFlags And DPNPLAYER_LOCAL = DPNPLAYER_LOCAL) Then glMyPlayerID = dpp.GetPlayerOrGroup(lCount)
Set lItem = lvMembers.ListItems.Add(, "K" & CStr(dpp.GetPlayerOrGroup(lCount)), sName)
lItem.SubItems(1) = "Silent"
lItem.SubItems(2) = cboMyGroup.List(0)
lItem.SubItems(3) = cboTalkingGroup.List(0)
End If
Next lCount
End Sub
Private Function GetGroupID(ByVal lIndex As Long) As Long
Dim lCount As Long
Dim dpGroup As DPN_GROUP_INFO
For lCount = 1 To dpp.GetCountPlayersAndGroups(DPNENUM_GROUPS)
dpGroup = dpp.GetGroupInfo(dpp.GetPlayerOrGroup(lCount))
If dpGroup.Name = "Group" & CStr(lIndex) Then
GetGroupID = dpp.GetPlayerOrGroup(lCount)
End If
Next lCount
End Function
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
If dpnotify.hResultCode <> 0 Then
'For some reason we could not connect. All available slots must be closed.
MsgBox "Connect Failed. Error: 0x" & CStr(Hex$(dpnotify.hResultCode)) & " - This sample will now close.", vbOKOnly Or vbCritical, "Closing"
DPlayEventsForm.CloseForm Me
End If
End Sub
Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
Dim lGroupNum As Long
Dim dpGroup As DPN_GROUP_INFO
dpGroup = dpp.GetGroupInfo(lGroupID)
lGroupNum = CLng(Right$(dpGroup.Name, 1))
glGroupID(lGroupNum) = lGroupID
End Sub
Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
Dim dpPeer As DPN_PLAYER_INFO
dpPeer = dpp.GetPeerInfo(lPlayerID)
AddPlayer lPlayerID, dpPeer.Name
If (dpPeer.lPlayerFlags And DPNPLAYER_LOCAL) = DPNPLAYER_LOCAL Then
glMyPlayerID = lPlayerID
End If
End Sub
Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
RemovePlayer lPlayerID
If lPlayerID = glMyPlayerID Then
glMyPlayerID = 0
End If
End Sub
Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
If lNewHostID = glMyPlayerID Then
frmVoice.Caption = frmVoice.Caption & " (HOST)"
End If
End Sub
Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
Dim lCount As Long, lOffset As Long
Dim lMsg As Long
Dim lIndex As Long
'Here we will go through the messages
'The first item in our byte array is the MSGID we passed in
With dpnotify
GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
Select Case lMsg
Case MSG_CHANGEGROUP
GetDataFromBuffer .ReceivedData, lIndex, LenB(lIndex), lOffset
frmVoice.UpdateGroup dpnotify.idSender, lIndex
Case MSG_CHANGETALK
GetDataFromBuffer .ReceivedData, lIndex, LenB(lIndex), lOffset
frmVoice.UpdateTarget dpnotify.idSender, lIndex
Case MSG_SERVERCHANGEGROUP
If DPlayEventsForm.IsHost Then
RemovePlayerFromAllGroups dpnotify.idSender
GetDataFromBuffer .ReceivedData, lIndex, LenB(lIndex), lOffset
If lIndex > 0 Then dpp.AddPlayerToGroup glGroupID(lIndex), dpnotify.idSender, 0
frmVoice.UpdateGroup dpnotify.idSender, lIndex
End If
End Select
End With
End Sub
Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_ConnectResult(ByVal ResultCode As Long)
If ResultCode <> 0 Then
'For some reason we could not connect. All available slots must be closed.
MsgBox "Connect Failed. Error: 0x" & CStr(Hex$(ResultCode)) & " - This sample will now close.", vbOKOnly Or vbCritical, "Closing"
DPlayEventsForm.CloseForm Me
End If
End Sub
Private Sub DirectPlayVoiceEvent8_CreateVoicePlayer(ByVal playerID As Long, ByVal flags As Long)
'Someone joined, update the player list
UpdatePlayerList
End Sub
Private Sub DirectPlayVoiceEvent8_DeleteVoicePlayer(ByVal playerID As Long)
'Someone quit, remove them from the session
RemovePlayer playerID
End Sub
Private Sub DirectPlayVoiceEvent8_DisconnectResult(ByVal ResultCode As Long)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_HostMigrated(ByVal NewHostID As Long, ByVal NewServer As DxVBLibA.DirectPlayVoiceServer8)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_InputLevel(ByVal PeakLevel As Long, ByVal RecordVolume As Long)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_OutputLevel(ByVal PeakLevel As Long, ByVal OutputVolume As Long)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_PlayerOutputLevel(ByVal playerID As Long, ByVal PeakLevel As Long)
'VB requires that we must implement *every* member of this interface
End Sub
Private Sub DirectPlayVoiceEvent8_PlayerVoiceStart(ByVal playerID As Long)
'Someone is talking, update the list
UpdateList playerID, True
End Sub
Private Sub DirectPlayVoiceEvent8_PlayerVoiceStop(ByVal playerID As Long)
'Someone stopped talking, update the list
UpdateList playerID, False
End Sub
Private Sub DirectPlayVoiceEvent8_RecordStart(ByVal PeakVolume As Long)
'I am talking, update the list
UpdateList glMyPlayerID, True
End Sub
Private Sub DirectPlayVoiceEvent8_RecordStop(ByVal PeakVolume As Long)
'I have quit talking, update the list
UpdateList glMyPlayerID, False
End Sub
Private Sub DirectPlayVoiceEvent8_SessionLost(ByVal ResultCode As Long)
'The voice session has exited, let's quit
MsgBox "The DirectPlayVoice session was lost. This sample is exiting.", vbOKOnly Or vbInformation, "Session lost."
DPlayEventsForm.CloseForm Me
End Sub

View File

@@ -0,0 +1,509 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmVoiceSettings
BorderStyle = 3 'Fixed Dialog
Caption = "Direct Play Voice Settings"
ClientHeight = 5010
ClientLeft = 45
ClientTop = 330
ClientWidth = 5835
Icon = "frmVoiceSettings.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5010
ScaleWidth = 5835
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdOk
Caption = "OK"
Default = -1 'True
Height = 375
Left = 4545
TabIndex = 36
Top = 4545
Width = 1215
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Height = 375
Left = 3255
TabIndex = 35
Top = 4545
Width = 1215
End
Begin VB.Frame fraServer
Caption = "Server Options (set only when creating a new session) "
Height = 1020
Left = 60
TabIndex = 1
Top = 3420
Width = 5700
Begin VB.Frame fraCompression
Caption = " Compression Codec "
Height = 660
Left = 120
TabIndex = 33
Top = 240
Width = 5475
Begin VB.ComboBox cboCompressionTypes
Height = 315
Left = 135
Style = 2 'Dropdown List
TabIndex = 34
Top = 255
Width = 5220
End
End
End
Begin VB.Frame Frame1
Caption = "Client Options (may be adjusted at any time) "
Height = 3195
Left = 60
TabIndex = 0
Top = 60
Width = 5715
Begin VB.Frame Frame3
Caption = " Aggressiveness "
Height = 1335
Index = 4
Left = 3000
TabIndex = 27
Top = 1740
Width = 1755
Begin VB.OptionButton optAggressivenessSet
Caption = "Set"
Height = 255
Left = 1020
TabIndex = 29
Top = 300
Width = 675
End
Begin VB.OptionButton optAgressivenessDefault
Caption = "Default"
Height = 195
Left = 60
TabIndex = 28
Top = 300
Value = -1 'True
Width = 855
End
Begin MSComctlLib.Slider sldAggressiveness
Height = 195
Left = 60
TabIndex = 30
Top = 780
Width = 1635
_ExtentX = 2884
_ExtentY = 344
_Version = 393216
Min = 1
Max = 100
SelStart = 1
TickFrequency = 10
Value = 1
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Max"
Height = 195
Index = 9
Left = 1320
TabIndex = 32
Top = 1080
Width = 315
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Min"
Height = 195
Index = 8
Left = 60
TabIndex = 31
Top = 1080
Width = 315
End
End
Begin VB.Frame Frame3
Caption = " Quality "
Height = 1335
Index = 3
Left = 1020
TabIndex = 21
Top = 1740
Width = 1755
Begin VB.OptionButton optQualityDefault
Caption = "Default"
Height = 195
Left = 60
TabIndex = 24
Top = 300
Value = -1 'True
Width = 855
End
Begin VB.OptionButton OptQualitySet
Caption = "Set"
Height = 255
Left = 1020
TabIndex = 23
Top = 300
Width = 675
End
Begin MSComctlLib.Slider sldQuality
Height = 195
Left = 60
TabIndex = 22
Top = 780
Width = 1635
_ExtentX = 2884
_ExtentY = 344
_Version = 393216
Min = 1
Max = 100
SelStart = 1
TickFrequency = 10
Value = 1
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Min"
Height = 195
Index = 7
Left = 60
TabIndex = 26
Top = 1080
Width = 315
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Max"
Height = 195
Index = 6
Left = 1320
TabIndex = 25
Top = 1080
Width = 315
End
End
Begin VB.Frame Frame3
Caption = "Threshold"
Height = 1335
Index = 2
Left = 3840
TabIndex = 14
Top = 300
Width = 1755
Begin VB.OptionButton optSensitivityDefault
Caption = "Default"
Height = 255
Left = 840
TabIndex = 17
Top = 300
Width = 855
End
Begin VB.OptionButton optnSensitivityAuto
Caption = "Auto"
Height = 195
Left = 60
TabIndex = 16
Top = 300
Value = -1 'True
Width = 735
End
Begin VB.OptionButton optSensitivitySet
Caption = "Set"
Height = 255
Left = 420
TabIndex = 15
Top = 540
Width = 855
End
Begin MSComctlLib.Slider sldSensitivity
Height = 195
Left = 60
TabIndex = 18
Top = 780
Width = 1635
_ExtentX = 2884
_ExtentY = 344
_Version = 393216
Max = 99
TickFrequency = 10
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Max"
Height = 195
Index = 5
Left = 1320
TabIndex = 20
Top = 1080
Width = 315
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Min"
Height = 195
Index = 4
Left = 60
TabIndex = 19
Top = 1080
Width = 315
End
End
Begin VB.Frame Frame3
Caption = " Record Volume "
Height = 1335
Index = 1
Left = 1980
TabIndex = 7
Top = 300
Width = 1755
Begin VB.OptionButton optRecordSet
Caption = "Set"
Height = 255
Left = 420
TabIndex = 13
Top = 540
Width = 855
End
Begin VB.OptionButton optRecordAuto
Caption = "Auto"
Height = 195
Left = 60
TabIndex = 10
Top = 300
Value = -1 'True
Width = 735
End
Begin VB.OptionButton optRecordDefault
Caption = "Default"
Height = 255
Left = 840
TabIndex = 9
Top = 300
Width = 855
End
Begin MSComctlLib.Slider sldRecord
Height = 195
Left = 60
TabIndex = 8
Top = 780
Width = 1635
_ExtentX = 2884
_ExtentY = 344
_Version = 393216
LargeChange = 500
SmallChange = 100
Min = -10000
Max = 0
TickFrequency = 1000
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Min"
Height = 195
Index = 3
Left = 60
TabIndex = 12
Top = 1080
Width = 315
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Max"
Height = 195
Index = 2
Left = 1320
TabIndex = 11
Top = 1080
Width = 315
End
End
Begin VB.Frame Frame3
Caption = " Playback Volume "
Height = 1335
Index = 0
Left = 120
TabIndex = 2
Top = 300
Width = 1755
Begin VB.OptionButton optVolumeSet
Caption = "Set"
Height = 255
Left = 1020
TabIndex = 4
Top = 300
Width = 675
End
Begin VB.OptionButton optVolumeDefault
Caption = "Default"
Height = 195
Left = 60
TabIndex = 3
Top = 300
Value = -1 'True
Width = 855
End
Begin MSComctlLib.Slider sldVolume
Height = 195
Left = 60
TabIndex = 37
Top = 780
Width = 1635
_ExtentX = 2884
_ExtentY = 344
_Version = 393216
LargeChange = 500
SmallChange = 100
Min = -10000
Max = 0
TickFrequency = 1000
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Max"
Height = 195
Index = 1
Left = 1320
TabIndex = 6
Top = 1080
Width = 315
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Min"
Height = 195
Index = 0
Left = 60
TabIndex = 5
Top = 1080
Width = 315
End
End
End
End
Attribute VB_Name = "frmVoiceSettings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: frmVoiceSettings.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdCancel_Click()
fGotSettings = False
Unload Me
End Sub
Private Sub cmdOk_Click()
fGotSettings = True
'Setup up the clients stuff
If optAgressivenessDefault.Value Then
oClient.lBufferAggressiveness = DVBUFFERAGGRESSIVENESS_DEFAULT
oSession.lBufferAggressiveness = DVBUFFERAGGRESSIVENESS_DEFAULT
Else
oClient.lBufferAggressiveness = sldAggressiveness.Value
oSession.lBufferAggressiveness = sldAggressiveness.Value
End If
If optQualityDefault Then
oClient.lBufferQuality = DVBUFFERQUALITY_DEFAULT
oSession.lBufferQuality = DVBUFFERQUALITY_DEFAULT
Else
oClient.lBufferQuality = sldQuality.Value
oSession.lBufferQuality = sldQuality.Value
End If
If optnSensitivityAuto.Value Then
oClient.lThreshold = DVTHRESHOLD_UNUSED
ElseIf optSensitivitySet Then
oClient.lThreshold = sldSensitivity.Value
oClient.lFlags = oClient.lFlags Or DVCLIENTCONFIG_MANUALVOICEACTIVATED
ElseIf optSensitivityDefault.Value Then
oClient.lThreshold = DVTHRESHOLD_DEFAULT
oClient.lFlags = oClient.lFlags Or DVCLIENTCONFIG_MANUALVOICEACTIVATED
End If
If optRecordAuto.Value Then
oClient.lFlags = oClient.lFlags Or DVCLIENTCONFIG_AUTOVOICEACTIVATED
ElseIf optRecordDefault.Value Then
oClient.lRecordVolume = 0
ElseIf optRecordSet.Value Then
oClient.lRecordVolume = sldRecord.Value
End If
If optVolumeDefault Then
oClient.lPlaybackVolume = DVPLAYBACKVOLUME_DEFAULT
ElseIf optVolumeSet Then
oClient.lPlaybackVolume = sldVolume.Value
End If
oClient.lNotifyPeriod = 0
'Now set up the server stuff
oSession.lSessionType = DVSESSIONTYPE_PEER
Dim oData As DVCOMPRESSIONINFO
dvServer.GetCompressionType cboCompressionTypes.ListIndex + 1, oData, 0
oSession.guidCT = oData.guidType
Unload Me
End Sub
Public Sub ClientOnly()
fraServer.Enabled = False
fraCompression.Enabled = False
End Sub
Private Sub Form_Load()
Dim lIndex As Long
'Set up the defaults
sldAggressiveness.Min = DVBUFFERAGGRESSIVENESS_MIN
sldAggressiveness.Max = DVBUFFERAGGRESSIVENESS_MAX
sldAggressiveness.LargeChange = (DVBUFFERAGGRESSIVENESS_MAX - DVBUFFERAGGRESSIVENESS_MIN) \ 10
sldAggressiveness.TickFrequency = sldAggressiveness.LargeChange
sldQuality.Min = DVBUFFERQUALITY_MIN
sldQuality.Max = DVBUFFERQUALITY_MAX
sldQuality.LargeChange = (DVBUFFERQUALITY_MAX - DVBUFFERQUALITY_MIN) \ 10
sldQuality.TickFrequency = sldQuality.LargeChange
sldSensitivity.Min = DVTHRESHOLD_MIN
sldSensitivity.Max = DVTHRESHOLD_MAX
sldSensitivity.LargeChange = (DVTHRESHOLD_MAX - DVTHRESHOLD_MIN) \ 10
sldSensitivity.TickFrequency = sldSensitivity.LargeChange
Dim lCount As Long, oData As DVCOMPRESSIONINFO
If (dvServer Is Nothing) Then Set dvServer = dx.DirectPlayVoiceServerCreate
For lCount = 1 To dvServer.GetCompressionTypeCount
dvServer.GetCompressionType lCount, oData, 0
cboCompressionTypes.AddItem oData.strName
If InStr(oData.strName, "sc03") Then
lIndex = lCount - 1
End If
Next
cboCompressionTypes.ListIndex = lIndex
End Sub
Private Sub optRecordAuto_Click()
If optRecordAuto.Value Then
If optSensitivityDefault.Value Then optnSensitivityAuto.Value = True
End If
End Sub
Private Sub optSensitivityDefault_Click()
If optSensitivityDefault.Value Then
If optRecordAuto.Value Then optRecordSet.Value = True
End If
End Sub
Private Sub optSensitivitySet_Click()
If optSensitivitySet.Value = True Then
optRecordDefault.Value = True
End If
End Sub

View File

@@ -0,0 +1,29 @@
//-----------------------------------------------------------------------------
//
// Sample Name: VB Voice Group Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
VoiceGroup is similar in form to SimpleVoice. Once a player hosts or connects
to a session, the players can chat with either other.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectPlay\VoiceGroup
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectPlay\Bin
User's Guide
============
Refer to User's Guide section of the SimpleVoice sample.
Programming Notes
=================
The Voice differs by letting clients send audio data to all players
connected to the session, or to specify which group to send to.

View File

@@ -0,0 +1,37 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
Form=frmVoice.frm
Module=DplayModule; Dplay.bas
Form=frmVoiceSettings.frm
Form=..\..\common\DplayCon.frm
IconForm="frmVoice"
Startup="Sub Main"
HelpFile=""
Title="vb_VoiceGroup"
Command32=""
Name="vbVoiceGroup"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1