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,443 @@
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmEffects
BorderStyle = 1 'Fixed Single
Caption = "Audio Effects using DirectMusic AudioPaths"
ClientHeight = 4845
ClientLeft = 45
ClientTop = 330
ClientWidth = 4800
Icon = "frmFX.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4845
ScaleWidth = 4800
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkLoop
Caption = "Loop Sound"
Height = 315
Left = 780
TabIndex = 15
Top = 4380
Width = 1455
End
Begin VB.CommandButton cmdStop
Caption = "&Stop"
Height = 375
Left = 3540
TabIndex = 14
Top = 4380
Width = 1095
End
Begin VB.CommandButton cmdPlay
Caption = "&Play"
Height = 375
Left = 2340
TabIndex = 13
Top = 4380
Width = 1095
End
Begin VB.Frame fraEffects
Caption = "Effects Information"
Height = 3495
Left = 120
TabIndex = 2
Top = 780
Width = 4515
Begin VB.TextBox txtFile
Height = 285
Left = 120
Locked = -1 'True
TabIndex = 9
Text = "No file loaded..."
Top = 480
Width = 3855
End
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 285
Left = 3960
TabIndex = 8
Top = 480
Width = 315
End
Begin VB.ListBox lstAvail
Height = 1815
ItemData = "frmFX.frx":0442
Left = 120
List = "frmFX.frx":045E
TabIndex = 7
Top = 1080
Width = 1875
End
Begin VB.ListBox lstUse
Height = 1815
Left = 2400
TabIndex = 6
Top = 1080
Width = 1875
End
Begin VB.CommandButton cmdAdd
Caption = ">"
Height = 285
Left = 2040
TabIndex = 5
Top = 1500
Width = 315
End
Begin VB.CommandButton cmdRemove
Caption = "<"
Height = 285
Left = 2040
TabIndex = 4
Top = 2220
Width = 315
End
Begin VB.CommandButton cmdApply
Caption = "Apply Effects"
Height = 315
Left = 3120
TabIndex = 3
Top = 3000
Width = 1215
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Currently loaded sound file:"
Height = 195
Index = 0
Left = 120
TabIndex = 12
Top = 240
Width = 4515
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Available Effects"
Height = 195
Index = 1
Left = 120
TabIndex = 11
Top = 840
Width = 1215
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Effects in use"
Height = 195
Index = 2
Left = 2700
TabIndex = 10
Top = 840
Width = 1215
End
End
Begin MSComDlg.CommonDialog cdlOpen
Left = 300
Top = 3720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Audio Effects using DirectMusic Audiopaths"
Height = 255
Index = 4
Left = 660
TabIndex = 1
Top = 60
Width = 3195
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
Height = 435
Index = 3
Left = 660
TabIndex = 0
Top = 300
Width = 3555
End
Begin VB.Image Image1
Height = 480
Left = 120
Picture = "frmFX.frx":04AF
Top = 180
Width = 480
End
End
Attribute VB_Name = "frmEffects"
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: frmFX.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API declare for windows folder
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Const mlMaxEffects As Long = 20
'Private declares for our DirectX objects
Private dx As DirectX8
Private dmp As DirectMusicPerformance8
Private dml As DirectMusicLoader8
Private dmSeg As DirectMusicSegment8
Private dmSegState As DirectMusicSegmentState8
Private Sub cmdAdd_Click()
If lstAvail.ListIndex = -1 Then 'Nothing is selected
MsgBox "Please select an available effect before attempting to add it.", vbOKOnly Or vbInformation, "Nothing selected."
Exit Sub
End If
If lstUse.ListCount >= mlMaxEffects Then
MsgBox "You cannot add more than " & CStr(mlMaxEffects) & " effects in this sample.", vbOKOnly Or vbInformation, "No more effects."
Exit Sub
End If
'Add this item to our list of effects
lstUse.AddItem lstAvail.List(lstAvail.ListIndex)
End Sub
Private Sub cmdApply_Click()
On Local Error GoTo NoFX
Dim DSEffects() As DSEFFECTDESC
Dim lResults() As Long
Dim lCount As Long
Dim dsb As DirectSoundSecondaryBuffer8
'Do we have a sound buffer
If dmSeg Is Nothing Then
MsgBox "You must first load an audio file before you can apply effects to it.", vbOKOnly Or vbInformation, "No buffer"
Exit Sub
End If
'Yup, stop a sound already playing
If dmp.IsPlaying(dmSeg, dmSegState) = True Then
MsgBox "Stop the currently playing sound before adding effects.", vbOKOnly Or vbInformation, "Sound is playing"
Exit Sub
End If
'Yes we do, do we have effects selected?
If lstUse.ListCount = 0 Then
If MsgBox("Do you want to turn off effects for this buffer?", vbYesNo Or vbQuestion, "No effects") = vbYes Then
'We need to get a DirectSoundSecondaryBuffer from the audio path
Set dsb = dmp.GetDefaultAudioPath.GetObjectinPath(DMUS_PCHANNEL_ALL, DMUS_PATH_BUFFER, 0, GUID_ALL, 0, IID_DirectSoundSecondaryBuffer)
'Before we can call SetFX on our Audio Path, we need to deactivate it first
dmp.GetDefaultAudioPath.Activate False
'Go ahead and apply our effects
dsb.SetFX 0, DSEffects, lResults
'Now we can reactivate our audio path
dmp.GetDefaultAudioPath.Activate True
Exit Sub
Else
MsgBox "You must first select some effects to use.", vbOKOnly Or vbInformation, "No effects"
Exit Sub
End If
End If
'Ok, let's apply our effects info here
'First get an array of effects structs the right size
ReDim DSEffects(lstUse.ListCount - 1)
ReDim lResults(lstUse.ListCount - 1)
For lCount = 0 To lstUse.ListCount - 1
Select Case LCase(lstUse.List(lCount))
Case "distortion"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_DISTORTION
Case "echo"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_ECHO
Case "chorus"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_CHORUS
Case "flanger"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_FLANGER
Case "compressor"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_COMPRESSOR
Case "gargle"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_GARGLE
Case "parameq"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_PARAMEQ
Case "wavesreverb"
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_WAVES_REVERB
End Select
Next
'We need to get a DirectSoundSecondaryBuffer from the audio path
Set dsb = dmp.GetDefaultAudioPath.GetObjectinPath(DMUS_PCHANNEL_ALL, DMUS_PATH_BUFFER, 0, GUID_ALL, 0, IID_DirectSoundSecondaryBuffer)
'Before we can call SetFX on our Audio Path, we need to deactivate it first
dmp.GetDefaultAudioPath.Activate False
'Go ahead and apply our effects
dsb.SetFX lstUse.ListCount, DSEffects, lResults
'Now we can reactivate our audio path
dmp.GetDefaultAudioPath.Activate True
Exit Sub
NoFX:
MsgBox "This set of effects could not be set on this audio file.", vbOKOnly Or vbInformation, "Cannot set"
End Sub
Private Sub cmdBrowse_Click()
Static sCurDir As String
'We want to open a file now
cdlOpen.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
cdlOpen.Filter = "Wave Files (*.wav)|*.wav|Music Files (*.mid;*.rmi)|*.mid;*.rmi|Segment Files (*.sgt)|*.sgt|All Audio Files|*.wav;*.mid;*.rmi;*.sgt|All Files (*.*)|*.*"
cdlOpen.FileName = vbNullString
If sCurDir = vbNullString Then
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
Dim sWindir As String
sWindir = Space$(255)
If GetWindowsDirectory(sWindir, 255) = 0 Then
'We couldn't get the windows folder for some reason, use the c:\
cdlOpen.InitDir = "C:\"
Else
Dim sMedia As String
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
If Right$(sWindir, 1) = "\" Then
sMedia = sWindir & "Media"
Else
sMedia = sWindir & "\Media"
End If
'We are trying to find the windows\media directory. If it
'doesn't exist, then use the windows folder as a default
If Dir$(sMedia, vbDirectory) <> vbNullString Then
cdlOpen.InitDir = sMedia
Else
cdlOpen.InitDir = sWindir
End If
End If
Else
'No need to move folders. Stay where they picked the last file
cdlOpen.InitDir = sCurDir
End If
On Local Error GoTo ClickedCancel
cdlOpen.CancelError = True
cdlOpen.ShowOpen ' Display the Open dialog box
'Save the current information
sCurDir = GetFolder(cdlOpen.FileName)
On Local Error GoTo NoLoadSegment
'Before we load the buffer stop one if it's playing
If Not (dmSeg Is Nothing) Then
dmp.StopEx dmSeg, 0, 0
dmSeg.Unload dmp.GetDefaultAudioPath
Set dmSeg = Nothing
End If
'Now let's load the segment
dml.SetSearchDirectory sCurDir
Set dmSeg = dml.LoadSegment(cdlOpen.FileName)
If (Right$(cdlOpen.FileName, 4) = ".mid") Or (Right$(cdlOpen.FileName, 4) = ".rmi") Or (Right$(cdlOpen.FileName, 5) = ".midi") Then
dmSeg.SetStandardMidiFile
End If
dmSeg.Download dmp.GetDefaultAudioPath
txtFile.Text = cdlOpen.FileName
Exit Sub
NoLoadSegment:
If Err.Number = DSERR_BUFFERTOOSMALL Then 'This buffer isn't big enough to control effects on
MsgBox "This file isn't long enough to control effects. Please choose a longer audio file.", vbOKOnly Or vbCritical, "Couldn't load"
Else 'Some other error
MsgBox "Couldn't load this file", vbOKOnly Or vbCritical, "Couldn't load"
End If
txtFile.Text = "No file loaded..."
ClickedCancel:
End Sub
Private Sub cmdPlay_Click()
If dmSeg Is Nothing Then
MsgBox "You must first load a audio file before you can play it.", vbOKOnly Or vbInformation, "No buffer"
Exit Sub
End If
If chkLoop.Value = vbChecked Then
dmSeg.SetRepeats -1
Else
dmSeg.SetRepeats 0
End If
Set dmSegState = dmp.PlaySegmentEx(dmSeg, DMUS_SEGF_DEFAULT, 0, , dmp.GetDefaultAudioPath)
End Sub
Private Sub cmdRemove_Click()
If lstUse.ListIndex = -1 Then 'Nothing is selected
MsgBox "Please select an effect that's being used before attempting to remove it.", vbOKOnly Or vbInformation, "Nothing selected."
Exit Sub
End If
'Add this item to our list of effects
lstUse.RemoveItem lstUse.ListIndex
End Sub
Private Sub cmdStop_Click()
If dmSeg Is Nothing Then
MsgBox "You must first load an audio file before you can stop it.", vbOKOnly Or vbInformation, "No buffer"
Exit Sub
End If
dmp.StopEx dmSeg, 0, 0
End Sub
Private Sub Form_Load()
InitAudio
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End Sub
Private Sub InitAudio()
On Local Error Resume Next
Dim dma As DMUS_AUDIOPARAMS
Set dx = New DirectX8
'Create our default Performance and Loader objects
Set dmp = dx.DirectMusicPerformanceCreate
Set dml = dx.DirectMusicLoaderCreate
'We want to be able to get a buffer, and control effects.
dmp.InitAudio Me.hWnd, DMUS_AUDIOF_EAX Or DMUS_AUDIOF_BUFFERS, dma, , DMUS_APATH_DYNAMIC_3D, 128
'Make sure we did init the audio
If Err <> 0 Then 'Nope we didn't
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End If
End Sub
Private Sub Cleanup()
'Let's clean up now
If Not dmSeg Is Nothing Then
'If we are playing our file, stop it
dmp.StopEx dmSeg, 0, 0
dmSeg.Unload dmp.GetDefaultAudioPath
End If
'Destroy our objects
Set dmSeg = Nothing
If Not (dmp Is Nothing) Then dmp.CloseDown
Set dmp = Nothing
Set dml = Nothing
Set dx = Nothing
End Sub
Private Function GetFolder(ByVal sFile As String) As String
Dim lCount As Long
For lCount = Len(sFile) To 1 Step -1
If Mid$(sFile, lCount, 1) = "\" Then
GetFolder = Left$(sFile, lCount)
Exit Function
End If
Next
GetFolder = vbNullString
End Function
Private Sub lstAvail_DblClick()
'Double clicking should be the same as clicking the 'Add' button
cmdAdd_Click
End Sub
Private Sub lstUse_DblClick()
'Double clicking should be the same as clicking the 'Remove' button
cmdRemove_Click
End Sub

View File

@@ -0,0 +1,41 @@
//-----------------------------------------------------------------------------
//
// Sample Name: VB Audio Effects Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
//
//-----------------------------------------------------------------------------
Description
===========
The sample demonstrates:
How to use standard effects (FX) with DirectMusic
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\AudioEffects
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\Bin
User's Guide
============
- make sure a sound file is loaded (can be WAV, MID, SGT, or RMI)
- by default, no FX are enabled. try playing the sound to see what it
orginally sounds like.
- enable one or more FXs by adding them to the 'In use' listbox and Apply them
- Hit play to hear the FX applied.
Programming Notes
=================
To Enable a standard effect, ultimately, you need to obtain a DirectSoundSecondaryBuffer.
Fill one or more DSEFFECTDESC structs, and pass them into DirectSoundSecondaryBuffer.SetFX.

View File

@@ -0,0 +1,32 @@
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={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Form=frmFX.frm
Startup="frmEffects"
HelpFile=""
Command32=""
Name="vbAudioEffects"
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

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,40 @@
//-----------------------------------------------------------------------------
//
// Sample Name: Audio Path Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
This sample shows the effects of playing multiple files across different audio
paths, how they can be mixed, and how music is played at the tempo of the primary
audio path.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\vbAudioPath
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\bin
User's Guide
============
You may add one file to the 'Primary' audio path, and 0 to 5 files to each of the two
secondary audio paths. Each audio path can be played separately and has separate controls
for volume and 3D positioning.
Programming Notes
=================
At the start of the application we create 3 default audio paths. We allow 1 audio file
to be loaded into the first audio path, and 0 to 5 loaded in each of the next two. When
Play is clicked on the first audio path, we call PlaySegmentEx with the DMUS_SEGF_DEFAULT
flag to clarify that this is the primary segment. Each of the other audio paths call
PlaySegmentEX with the DMUS_SEGF_SECONDARY flag to play as secondary segments.
If Looping is selected on an audio path we call SetRepeats with INIFINITE, otherwise we
call SetRepeats with 0. To change the volume or 3D Positioning of any audio path we first
call GetObjectInPath to retreive a DirectSoundSecondaryBuffer or DirectSound3DBuffer, and
then call SetVolume or SetPosition, respectively.

View File

@@ -0,0 +1,34 @@
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
Form=frmAudioPath.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
IconForm="frmAudioPath"
Startup="frmAudioPath"
ExeName32="vb_AudioPath.exe"
Command32=""
Name="vbAudioPath"
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

View File

@@ -0,0 +1,493 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "DLS Sound Effects"
ClientHeight = 4920
ClientLeft = 45
ClientTop = 330
ClientWidth = 5670
Icon = "DLSFX.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4920
ScaleWidth = 5670
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame1
Caption = "Heartbeat"
Height = 3255
Left = 120
TabIndex = 17
Top = 1560
Width = 2895
Begin VB.CommandButton cmdB7
Caption = "&On"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 480
TabIndex = 8
Top = 360
Width = 735
End
Begin VB.CommandButton cmdOff
Caption = "O&ff"
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1800
TabIndex = 9
Top = 360
Width = 735
End
Begin MSComctlLib.Slider sliderB7
Height = 375
Left = 360
TabIndex = 11
Top = 1440
Width = 2295
_ExtentX = 4048
_ExtentY = 661
_Version = 393216
LargeChange = 3
Min = 1
Max = 13
SelStart = 1
Value = 1
End
Begin MSComctlLib.Slider sliderPitch
Height = 375
Left = 360
TabIndex = 13
Top = 2400
Width = 2295
_ExtentX = 4048
_ExtentY = 661
_Version = 393216
LargeChange = 1365
SmallChange = 128
Max = 16383
SelStart = 8065
TickFrequency = 1365
Value = 8065
End
Begin VB.Label Label2
Caption = "&Note (B7-B8)"
Height = 255
Left = 480
TabIndex = 10
Top = 1080
Width = 1695
End
Begin VB.Label lblPitch
Caption = "&Pitch Bend"
Height = 255
Left = 480
TabIndex = 12
Top = 2040
Width = 1815
End
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "E&xit"
Height = 495
Left = 3720
TabIndex = 16
Top = 3120
Width = 1335
End
Begin VB.CommandButton cmdC10
BackColor = &H00FFFFFF&
Caption = "C&10"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4688
TabIndex = 6
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC9
Caption = "C&9"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3968
TabIndex = 5
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC5
Caption = "C&5"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1808
TabIndex = 2
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC4
Caption = "C&4"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1088
TabIndex = 1
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC6
Caption = "C&6"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2528
TabIndex = 3
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC3
Caption = "C&3"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 368
TabIndex = 0
Top = 720
Width = 615
End
Begin VB.CommandButton cmdC7
Caption = "C&7"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3248
TabIndex = 4
Top = 720
Width = 615
End
Begin MSComctlLib.Slider sliderVelocity
Height = 195
Left = 3360
TabIndex = 15
Top = 1920
Width = 2295
_ExtentX = 4048
_ExtentY = 344
_Version = 393216
LargeChange = 16
Max = 127
SelStart = 127
TickFrequency = 16
Value = 127
End
Begin VB.Label Label3
Caption = "&Velocity of New Notes"
Height = 255
Left = 3480
TabIndex = 14
Top = 1560
Width = 1935
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "Boids.dls - ""Vocals"" Instrument Regions"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 428
TabIndex = 7
Top = 240
Width = 4815
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: dlsfx.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This application demonstrates the use of Downloadable Sounds for sound
' effects, and how to send MIDI notes.
' The DLS instruments are taken from Boids.dls. That collection actually
' contains only a single instrument, called Vocals. However, the instrument
' is based on different wave samples for different "regions" or ranges
' of notes. For example, the first speech sound is used when any note
' between C3 and B3 is sent. The speech sounds are played at the correct
' pitch only when the note is the lowest one in the region.
' One of the samples, called Heartbeat, is valid for the range B7-B8.
' Because this is not a vocal sample, we can reasonably vary the pitch
' by playing various notes within that range, as determined by the
' slider setting.
' Heartbeat is also the only sample in the DLS collection that is based
' on a looped wave. Hence it can be played continuously for up to the
' maximum duration of a note. The other samples will play only once
' regardless of the duration of the note sent.
Option Explicit
Const patch = 127 ' Assigned to "Vocals" instrument in Boids.dls
Const channel = 1
Const hbchannel = 32
' NoteDur is the duration of any of the non-repeating samples. It should
' be long enough to accommodate all the sound effects but not so long
' that notes continue using up resources (voices) after the sample has
' finished playing. Note that if you send the same note before the last
' one has finished playing, it might not play properly.
Const NoteDurC3 = 4000 ' milliseconds
Const NoteDurC4 = 7000 ' milliseconds
Const NoteDurC5 = 5500 ' milliseconds
Const NoteDurC6 = 5000 ' milliseconds
Const NoteDurC7 = 2800 ' milliseconds
Const NoteDurC9 = 5000 ' milliseconds
Const NoteDurC10 = 3800 ' milliseconds
Dim B7Freq As Byte
Dim B7Playing As Boolean
Dim gVelocity As Byte
Dim mediapath As String
Dim dx As New DirectX8
Dim perf As DirectMusicPerformance8
Dim coll As DirectMusicCollection8
Dim seg As DirectMusicSegment8
Private Sub SendNote(chan As Integer, pitch As Byte, dur As Long)
Dim noteMsg As DMUS_NOTE_PMSG
noteMsg.velocity = gVelocity
noteMsg.flags = DMUS_NOTEF_NOTEON
noteMsg.midiValue = pitch
noteMsg.mtDuration = dur
Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, chan, noteMsg)
End Sub
Private Sub B7NoteOff()
' To turn off a note, we send a note-off message on the same
' channel and at the same pitch.
Dim noteMsg As DMUS_NOTE_PMSG
noteMsg.flags = 0
noteMsg.midiValue = B7Freq
Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, hbchannel, noteMsg)
End Sub
Private Sub cmdB7_Click()
' For the hearbeat we'll send the note using a standard MIDI message.
' That way we don't have to worry about the duration of the note;
' it will play till we stop it.
Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity)
B7Playing = True
cmdB7.Enabled = False
cmdOff.Enabled = True
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOff_Click()
B7NoteOff
B7Playing = False
cmdB7.Enabled = True
cmdOff.Enabled = False
End Sub
Private Sub cmdC3_Click()
SendNote channel, 36, NoteDurC3
End Sub
Private Sub cmdC4_Click()
SendNote channel, 48, NoteDurC4
End Sub
Private Sub cmdC5_Click()
SendNote channel, 60, NoteDurC5
End Sub
Private Sub cmdC6_Click()
SendNote channel, 72, NoteDurC6
End Sub
Private Sub cmdC7_Click()
SendNote channel, 84, NoteDurC7
End Sub
Private Sub cmdC9_Click()
SendNote channel, 108, NoteDurC9
End Sub
Private Sub cmdC10_Click()
SendNote channel, 120, NoteDurC10
End Sub
Private Sub Form_Load()
On Error GoTo FAILEDINIT
Dim dmA As DMUS_AUDIOPARAMS
Set perf = dx.DirectMusicPerformanceCreate
perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 64
On Error GoTo FAILEDLOAD
mediapath = FindMediaDir("sample.sgt")
If mediapath <> vbNullString Then ChDir mediapath
Dim loader As DirectMusicLoader8
Set loader = dx.DirectMusicLoaderCreate
Set coll = loader.LoadCollection(mediapath & "boids.dls")
' Load any segment. We're not actually going to play it,
' but we need a valid segment object so we can download the DLS.
Set seg = loader.LoadSegment(mediapath & "sample.sgt")
seg.ConnectToCollection coll
seg.Download perf.GetDefaultAudioPath
On Error GoTo 0
' Assign the Vocals instrument to two channels
' One will be used only for the heartbeat so we can pitch bend
Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, channel, patch, 5, 0)
Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, patch, 5, 0)
' Initialize heartbeat note. B7 is MIDI note 95.
B7Freq = sliderB7.Value + 94
gVelocity = sliderVelocity.Value
Exit Sub
FAILEDINIT:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
Exit Sub
FAILEDLOAD:
MsgBox "Failed to load file."
Unload Me
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not (seg Is Nothing) Then seg.Unload perf.GetDefaultAudioPath
Set seg = Nothing
If Not (perf Is Nothing) Then perf.CloseDown
Set perf = Nothing
End
End Sub
Private Sub sliderB7_Change()
B7NoteOff
B7Freq = 94 + sliderB7.Value
If B7Playing Then
Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity)
End If
End Sub
Private Sub sliderPitch_Change()
Dim hi As Byte, lo As Byte
' Split value into 7-bit bytes
hi = Fix(sliderPitch.Value / 128)
lo = CByte(sliderPitch.Value And 127)
' Send pitch bend message
Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &HE0, _
lo, hi)
End Sub
Private Sub sliderVelocity_Change()
gVelocity = sliderVelocity.Value
End Sub

View File

@@ -0,0 +1,49 @@
//-----------------------------------------------------------------------------
//
// Sample Name: DLS Effects Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
This application demonstrates the use of Downloadable Sounds for sound
effects, and how to send MIDI notes.
The DLS instruments are taken from Boids.dls. That collection actually
contains only a single instrument, called Vocals. However, the instrument
is based on different wave samples for different "regions" or ranges
of notes. For example, the first speech sound is used when any note
between C3 and B3 is sent. The speech sounds are played at the correct
pitch only when the note is the lowest one in the region.
One of the samples, called Heartbeat, is valid for the range B7-B8.
Because this is not a vocal sample, we can reasonably vary the pitch
by playing various notes within that range, as determined by the
slider setting.
Heartbeat is also the only sample in the DLS collection that is based
on a looped wave. Hence it can be played continuously for up to the
maximum duration of a note. The other samples will play only once
regardless of the duration of the note sent.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\DLSEffects
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\bin
User's Guide
============
Clicking any of the 'Notes' will play the associated vocal. You may also turn
Heartbeat on or off, and change the pitch, or velocity of notes.
Programming Notes
=================
This sample shows how to control notes in a DLS using SendNotePMsg, and SendMidiPmsg.
Whenever a note is clicked, we will call SendNotePMsg to turn the note on, for a specific
duration (which varies for each note). When we want to turn the Heartbeat on we will call
SendMidiPMsg, and then call SendNotePMsg once more to turn the Heartbeat off.

View File

@@ -0,0 +1,33 @@
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
Form=DLSFX.frm
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
Module=MediaDir; ..\..\common\media.bas
Startup="frmMain"
HelpFile=""
ExeName32="VB_DLSEffects.exe"
Command32=""
Name="DLSEffects"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
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
ThreadPerObject=0
MaxNumberOfThreads=1

View File

@@ -0,0 +1,639 @@
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form main
BorderStyle = 1 'Fixed Single
Caption = "DMDrums"
ClientHeight = 5505
ClientLeft = 45
ClientTop = 330
ClientWidth = 6255
Icon = "main.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5505
ScaleWidth = 6255
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkReverb
Caption = "Play with environmental reverb"
Height = 255
Left = 1140
TabIndex = 39
Top = 1500
Value = 1 'Checked
Width = 3015
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "Exit"
Height = 495
Left = 5340
TabIndex = 31
Top = 4980
Width = 855
End
Begin MSComCtl2.UpDown UpDown_Volume
Height = 375
Left = 1740
TabIndex = 36
TabStop = 0 'False
Top = 960
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
Value = 100
Max = 100
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown_Tempo
Height = 375
Left = 1740
TabIndex = 35
TabStop = 0 'False
Top = 360
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
Value = 120
Max = 1000
Min = 1
Enabled = -1 'True
End
Begin VB.TextBox EDIT_Tempo
Height = 375
Left = 1200
MaxLength = 4
TabIndex = 0
Text = "120"
Top = 360
Width = 495
End
Begin VB.TextBox EDIT_Volume
Height = 375
Left = 1200
TabIndex = 1
Text = "100"
Top = 960
Width = 495
End
Begin VB.CommandButton Stop
Height = 495
Left = 3720
Picture = "main.frx":0442
Style = 1 'Graphical
TabIndex = 3
Top = 840
Width = 495
End
Begin VB.CommandButton Play
Height = 495
Left = 3120
Picture = "main.frx":08F8
Style = 1 'Graphical
TabIndex = 2
Top = 840
Width = 495
End
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 1695
Left = 120
Picture = "main.frx":0E8A
ScaleHeight = 1695
ScaleWidth = 855
TabIndex = 32
TabStop = 0 'False
Top = 120
Width = 855
End
Begin VB.ListBox LIST_Grooves
Height = 2400
Left = 4320
TabIndex = 29
Top = 840
Width = 1815
End
Begin VB.ListBox LIST_Bands
Height = 1425
Left = 4320
TabIndex = 30
Top = 3480
Width = 1815
End
Begin VB.CommandButton Drum
Caption = "High Q"
Height = 495
Index = 24
Left = 3480
TabIndex = 28
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Scratch"
Height = 495
Index = 23
Left = 2640
TabIndex = 27
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Sticks"
Height = 495
Index = 22
Left = 1800
TabIndex = 26
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Hand Clap"
Height = 495
Index = 21
Left = 960
TabIndex = 25
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Tamb- ourine"
Height = 495
Index = 20
Left = 120
TabIndex = 24
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Jingle Bells"
Height = 495
Index = 19
Left = 3480
TabIndex = 23
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Cast- anets"
Height = 495
Index = 18
Left = 2640
TabIndex = 22
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Shaker"
Height = 495
Index = 17
Left = 1800
TabIndex = 21
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Triangle"
Height = 495
Index = 16
Left = 960
TabIndex = 20
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Cuica"
Height = 495
Index = 15
Left = 120
TabIndex = 19
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Block"
Height = 495
Index = 14
Left = 3480
TabIndex = 18
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Block"
Height = 495
Index = 13
Left = 2640
TabIndex = 17
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Guiro"
Height = 495
Index = 12
Left = 1800
TabIndex = 16
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Agogo"
Height = 495
Index = 11
Left = 960
TabIndex = 15
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Timbale"
Height = 495
Index = 10
Left = 120
TabIndex = 14
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Conga"
Height = 495
Index = 9
Left = 3480
TabIndex = 13
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Conga"
Height = 495
Index = 8
Left = 2640
TabIndex = 12
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Crash"
Height = 495
Index = 7
Left = 1800
TabIndex = 11
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Splash"
Height = 495
Index = 6
Left = 960
TabIndex = 10
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Ride"
Height = 495
Index = 5
Left = 120
TabIndex = 9
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Tom"
Height = 495
Index = 4
Left = 3480
TabIndex = 8
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Mid Tom"
Height = 495
Index = 3
Left = 2640
TabIndex = 7
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Tom"
Height = 495
Index = 2
Left = 1800
TabIndex = 6
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Snare"
Height = 495
Index = 1
Left = 960
TabIndex = 5
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Kick"
Height = 495
Index = 0
Left = 120
TabIndex = 4
Top = 2040
Width = 735
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Drum Sets"
Height = 255
Index = 1
Left = 4320
TabIndex = 38
Top = 3240
Width = 1755
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Grooves"
Height = 255
Index = 0
Left = 4320
TabIndex = 37
Top = 600
Width = 1755
End
Begin VB.Label Label2
Caption = "Tempo:"
Height = 255
Left = 1200
TabIndex = 34
Top = 120
Width = 615
End
Begin VB.Label Label1
Caption = "Volume:"
Height = 255
Left = 1200
TabIndex = 33
Top = 720
Width = 615
End
End
Attribute VB_Name = "main"
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: main.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim dx As New DirectX8
Dim perf As DirectMusicPerformance8
Dim loader As DirectMusicLoader8
Dim style As DirectMusicStyle8
Dim band As DirectMusicBand8
Dim composer As DirectMusicComposer8
Dim seg As DirectMusicSegment8
Dim segBand As DirectMusicSegment8
Dim segMotif() As DirectMusicSegment8
Dim mediapath As String
Dim mtTime As Long
Private Sub chkReverb_Click()
'Ok, they want to switch the default audio paths
Dim dmPath As DirectMusicAudioPath8
If chkReverb.Value = vbUnchecked Then
Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 128, True)
Else
Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True)
End If
perf.SetDefaultAudioPath dmPath
ChangeBands
End Sub
Private Sub cmdExit_Click()
Stop_Click
Unload Me
End Sub
Private Sub Drum_Click(Index As Integer)
Call perf.PlaySegmentEx(segMotif(Index), DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub EDIT_Tempo_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
UpDown_Tempo.Value = EDIT_Tempo.Text
ChangeTempo (UpDown_Tempo.Value)
Else
EDIT_Tempo.Text = UpDown_Tempo.Value
End If
End If
If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Tempo_LostFocus()
If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
UpDown_Tempo.Value = EDIT_Tempo.Text
ChangeTempo (UpDown_Tempo.Value)
Else
EDIT_Tempo.Text = UpDown_Tempo.Value
End If
End Sub
Private Sub EDIT_Volume_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
UpDown_Volume.Value = EDIT_Volume.Text
ChangeVolume UpDown_Volume.Value
Else
EDIT_Volume.Text = UpDown_Volume.Value
End If
End If
If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Volume_LostFocus()
If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
UpDown_Volume.Value = EDIT_Volume.Text
ChangeVolume UpDown_Volume
Else
EDIT_Volume.Text = UpDown_Volume.Value
End If
End Sub
Private Sub Form_Load()
Dim dmA As DMUS_AUDIOPARAMS, lCount As Long
Dim MotifName As String
mediapath = FindMediaDir("Drums!.sgt")
Set perf = dx.DirectMusicPerformanceCreate()
Set loader = dx.DirectMusicLoaderCreate()
Set composer = dx.DirectMusicComposerCreate()
'Make sure we can init the audio as well
On Error GoTo FailedInit
' Initialize performance object to use its own DirectSound object
perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
' SetMasterAutoDownload indicates we the perofmance object
' to attempt to auto download DLS collections when reference in
' sgt and sty files
Call perf.SetMasterAutoDownload(True)
Set style = loader.LoadStyle(mediapath & "drums!.sty")
Set seg = loader.LoadSegment(mediapath & "drums!.sgt")
Get_Bands
LIST_Grooves.AddItem ("Alternative")
LIST_Grooves.AddItem ("Blues")
LIST_Grooves.AddItem ("Country")
LIST_Grooves.AddItem ("Dance - Pop")
LIST_Grooves.AddItem ("Hard Rock")
LIST_Grooves.AddItem ("Hip Hop")
LIST_Grooves.AddItem ("Jazz")
LIST_Grooves.AddItem ("Latin")
LIST_Grooves.AddItem ("R & B")
LIST_Grooves.AddItem ("Rap")
LIST_Grooves.AddItem ("Soft Rock")
LIST_Grooves.AddItem ("World")
' Download the default band so that we can play the drum pads immediately
ChangeBands
ChangeVolume UpDown_Volume.Value
ReDim segMotif(style.GetMotifCount() - 1)
For lCount = 0 To style.GetMotifCount() - 1
MotifName = style.GetMotifName(lCount)
'We could set the drum name here (but we'll just leave them hard coded)
'Drum(lCount).Caption = MotifName
Set segMotif(lCount) = style.GetMotif(MotifName)
Next
LIST_Grooves.ListIndex = 0
LIST_Bands.ListIndex = 0
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim lCount As Long
On Error Resume Next
If Not (segBand Is Nothing) Then
perf.StopEx segBand, 0, 0
segBand.Unload perf.GetDefaultAudioPath
End If
If Not (seg Is Nothing) Then perf.StopEx seg, 0, 0
Set seg = Nothing
For lCount = LBound(segMotif) To UBound(segMotif)
If Not (segMotif(lCount) Is Nothing) Then perf.StopEx segMotif(lCount), 0, 0
Set segMotif(lCount) = Nothing
Next
Set segBand = Nothing
Set style = Nothing
Set composer = Nothing
Set loader = Nothing
If Not (band Is Nothing) Then
Call band.Unload(perf)
End If
Set band = Nothing
If Not (perf Is Nothing) Then perf.CloseDown
Set perf = Nothing
End Sub
Private Sub Get_Bands()
Dim BandCount As Integer
Dim counter As Integer
BandCount = style.GetBandCount()
For counter = 0 To (BandCount - 1)
LIST_Bands.AddItem (style.GetBandName(BandCount - counter - 1))
Next counter
End Sub
Private Sub LIST_Bands_Click()
ChangeBands
End Sub
Private Sub LIST_Grooves_Click()
perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * 8) + 1)
End Sub
Private Sub Play_Click()
PlaySeg
ChangeBands
chkReverb.Enabled = False
End Sub
Private Sub Stop_Click()
perf.StopEx seg, 0, 0
chkReverb.Enabled = True
End Sub
Private Sub UPDOWN_Tempo_Change()
EDIT_Tempo.Text = UpDown_Tempo.Value
ChangeTempo (UpDown_Tempo.Value)
End Sub
Private Sub UPDOWN_Volume_Change()
EDIT_Volume.Text = UpDown_Volume.Value
Call ChangeVolume(UpDown_Volume.Value)
End Sub
Private Sub ChangeBands()
If Not (band Is Nothing) Then
Call band.Unload(perf)
End If
If LIST_Bands = vbNullString Then
Set band = style.GetBand("Standard")
Else
Set band = style.GetBand(LIST_Bands)
End If
Call band.Download(perf)
Set segBand = band.CreateSegment()
segBand.Download perf.GetDefaultAudioPath
Call perf.PlaySegmentEx(segBand, DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub PlaySeg()
Call perf.PlaySegmentEx(seg, 0, 0)
End Sub
Private Sub ChangeTempo(tempo As Integer)
perf.SendTempoPMSG 0, DMUS_PMSGF_REFTIME, tempo
End Sub
Sub ChangeVolume(ByVal n As Long)
If n = 0 Then
n = -10000
Else
n = (-50 * (100 - n))
End If
perf.SetMasterVolume n
End Sub

View File

@@ -0,0 +1,44 @@
//-----------------------------------------------------------------------------
//
// Sample Name: DMDrums Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The DMDrums sample illustrates playing Motif's from a
DirectMusic segment, as well as playing grooves from that
same segment using different instrument sets.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\DMDrums
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\bin
User's Guide
============
Clicking any of the drum buttons will play that Drum based on the
current grove and instrument set. You can also click the Play
button to play a default sample of that instrument set. Volume and
Tempo can also be changed.
Programming Notes
=================
On startup drums!.sgt and drums!.sty are loaded, and all motifs are
loaded from the style. All available bands are loaded next, and the
list of 'Grooves' are loaded. We then play each motif whenever the
corresponding button is pressed. If the Play button is stopped we
play the default segment.
Whenever a new band is selected we unload the current band, and then
load a new band (based on what is selected in the list box), and download
that band. We also call SetMasterGrooveLevel whenever the groove has changed.
Finally, we can turn on and off environmental reverb by changing the default
audio path for DirectMusic.

View File

@@ -0,0 +1,32 @@
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
Form=main.frm
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomct2.ocx
Module=MediaDir; ..\..\common\media.bas
Startup="main"
ExeName32="vb_dmdrums.exe"
Command32=""
Name="vbDMDrums"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="MS"
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
ThreadPerObject=0
MaxNumberOfThreads=1

View File

@@ -0,0 +1,433 @@
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmAudio
BorderStyle = 1 'Fixed Single
Caption = "Play Audio"
ClientHeight = 2520
ClientLeft = 150
ClientTop = 435
ClientWidth = 4890
Icon = "frmAudio.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2520
ScaleWidth = 4890
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame1
Caption = "Master Volume"
Height = 675
Index = 1
Left = 2520
TabIndex = 9
Top = 1680
Width = 2295
Begin MSComctlLib.Slider sldVolume
Height = 195
Left = 180
TabIndex = 10
Top = 420
Width = 1995
_ExtentX = 3519
_ExtentY = 344
_Version = 393216
LargeChange = 1000
SmallChange = 100
Min = -2500
Max = 200
SelStart = 200
TickFrequency = 500
Value = 200
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Max"
Height = 255
Index = 3
Left = 1860
TabIndex = 12
Top = 180
Width = 315
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Min"
Height = 255
Index = 1
Left = 180
TabIndex = 11
Top = 180
Width = 315
End
End
Begin VB.Frame fraTempo
Caption = "Tempo"
Height = 675
Left = 60
TabIndex = 8
Top = 1680
Width = 2295
Begin MSComctlLib.Slider sldTempo
Height = 195
Left = 120
TabIndex = 13
Top = 420
Width = 1995
_ExtentX = 3519
_ExtentY = 344
_Version = 393216
Max = 30
SelStart = 10
TickFrequency = 5
Value = 10
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Fast"
Height = 255
Index = 6
Left = 1680
TabIndex = 16
Top = 180
Width = 375
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Normal"
Height = 255
Index = 5
Left = 540
TabIndex = 15
Top = 180
Width = 615
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Slow"
Height = 255
Index = 4
Left = 120
TabIndex = 14
Top = 180
Width = 375
End
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 315
Left = 3840
TabIndex = 7
Top = 1260
Width = 975
End
Begin VB.CheckBox chkLoop
Caption = "Loop Audio"
Height = 255
Left = 60
TabIndex = 6
Top = 1320
Width = 1155
End
Begin VB.TextBox txtFile
BackColor = &H8000000F&
Height = 285
Left = 1140
Locked = -1 'True
TabIndex = 5
Top = 900
Width = 3675
End
Begin VB.CommandButton cmdOpen
Caption = "&Audio File"
Height = 315
Left = 120
TabIndex = 0
Top = 900
Width = 975
End
Begin VB.CommandButton cmdPlay
Caption = "&Play"
Enabled = 0 'False
Height = 315
Left = 1320
TabIndex = 1
Top = 1260
Width = 975
End
Begin VB.CommandButton cmdStop
Caption = "&Stop"
Enabled = 0 'False
Height = 315
Left = 2340
TabIndex = 2
Top = 1260
Width = 975
End
Begin MSComDlg.CommonDialog cdlOpen
Left = 3000
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Flags = 4
End
Begin VB.Image Image1
Height = 480
Left = 60
Picture = "frmAudio.frx":0442
Top = 60
Width = 480
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Copyright (C) 1999-2001 Microsoft Corporation All Rights Reserved."
Height = 495
Index = 2
Left = 600
TabIndex = 4
Top = 300
Width = 3015
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Play Audio Sample"
Height = 255
Index = 0
Left = 600
TabIndex = 3
Top = 60
Width = 2655
End
End
Attribute VB_Name = "frmAudio"
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: frmAudio.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Implements DirectXEvent8
Private dx As New DirectX8
'We need a loader object and a performance object
'We will play everything on our default audio path, so we do not need an audiopath object
Private dmp As DirectMusicPerformance8
Private dml As DirectMusicLoader8
Private dmSeg As DirectMusicSegment8
'Our event handle
Private dmEvent As Long
'API declare for windows folder
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub cmdExit_Click()
Unload Me 'Cleanup happens in form unload
End Sub
Private Sub cmdOpen_Click()
Static sCurDir As String
Static lFilter As Long
'We want to open a file now
cdlOpen.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
cdlOpen.FilterIndex = lFilter
cdlOpen.Filter = "Wave Files (*.wav)|*.wav|Music Files (*.mid;*.rmi)|*.mid;*.rmi|Segment Files (*.sgt)|*.sgt|All Audio Files|*.wav;*.mid;*.rmi;*.sgt|All Files (*.*)|*.*"
cdlOpen.FileName = vbNullString
If sCurDir = vbNullString Then
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
Dim sWindir As String
sWindir = Space$(255)
If GetWindowsDirectory(sWindir, 255) = 0 Then
'We couldn't get the windows folder for some reason, use the c:\
cdlOpen.InitDir = "C:\"
Else
Dim sMedia As String
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
If Right$(sWindir, 1) = "\" Then
sMedia = sWindir & "Media"
Else
sMedia = sWindir & "\Media"
End If
If Dir$(sMedia, vbDirectory) <> vbNullString Then
cdlOpen.InitDir = sMedia
Else
cdlOpen.InitDir = sWindir
End If
End If
Else
cdlOpen.InitDir = sCurDir
End If
On Local Error GoTo ClickedCancel
cdlOpen.CancelError = True
cdlOpen.ShowOpen ' Display the Open dialog box
'Save the current information
sCurDir = GetFolder(cdlOpen.FileName)
'Set the search folder to this one so we can auto download anything we need
dml.SetSearchDirectory sCurDir
lFilter = cdlOpen.FilterIndex
On Local Error GoTo NoLoadSegment
'Before we load the segment stop one if it's playing
cmdStop_Click
'Now let's load the segment
If FileLen(cdlOpen.FileName) = 0 Then Err.Raise 5
EnableTempoControl (Right$(cdlOpen.FileName, 4) <> ".wav")
Set dmSeg = dml.LoadSegment(cdlOpen.FileName)
If (Right$(cdlOpen.FileName, 4) = ".mid") Or (Right$(cdlOpen.FileName, 4) = ".rmi") Or (Right$(cdlOpen.FileName, 5) = ".midi") Then
dmSeg.SetStandardMidiFile
End If
txtFile.Text = cdlOpen.FileName
EnablePlayUI True
sldTempo.Value = 10
sldTempo_Click
Exit Sub
NoLoadSegment:
MsgBox "Couldn't load this segment", vbOKOnly Or vbCritical, "Couldn't load"
ClickedCancel:
End Sub
Private Sub cmdPlay_Click()
If Not (dmSeg Is Nothing) Then
If chkLoop.Value = vbChecked Then
dmSeg.SetRepeats -1 'Loop infinitely
Else
dmSeg.SetRepeats 0 'Don't loop
End If
dmp.PlaySegmentEx dmSeg, DMUS_SEGF_DEFAULT, 0
EnablePlayUI False
End If
End Sub
Private Sub cmdStop_Click()
If Not (dmSeg Is Nothing) Then dmp.StopEx dmSeg, 0, 0
EnablePlayUI True
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
Dim dmNotification As DMUS_NOTIFICATION_PMSG
'We only have one event
If Not dmp.GetNotificationPMSG(dmNotification) Then
MsgBox "Error processing this Notification", vbOKOnly Or vbInformation, "Cannot Process."
Exit Sub
Else
If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGEND Then 'The segment has ended
EnablePlayUI True
End If
End If
End Sub
Private Sub Form_Load()
InitAudio
EnableTempoControl False
End Sub
Private Sub InitAudio()
On Error GoTo FailedInit
'We need to create our objects now
Set dmp = dx.DirectMusicPerformanceCreate
Set dml = dx.DirectMusicLoaderCreate
Dim dmusAudio As DMUS_AUDIOPARAMS
'Now call init audio
dmp.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmusAudio, Nothing, DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
dmp.SetMasterAutoDownload True
'Now add a notification for the segment
dmp.AddNotificationType DMUS_NOTIFY_ON_SEGMENT
'Create an event so we can receive these
dmEvent = dx.CreateEvent(Me)
dmp.SetNotificationHandle dmEvent
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
CleanupAudio
Unload Me
End
End Sub
Private Sub CleanupAudio()
'Cleanup everything
On Error Resume Next
dmp.RemoveNotificationType DMUS_NOTIFY_ON_SEGMENT
dx.DestroyEvent dmEvent
If Not (dmSeg Is Nothing) Then dmp.StopEx dmSeg, 0, 0
Set dmSeg = Nothing
Set dml = Nothing
If Not (dmp Is Nothing) Then dmp.CloseDown
Set dmp = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
CleanupAudio
End Sub
Private Function GetFolder(ByVal sFile As String) As String
Dim lCount As Long
For lCount = Len(sFile) To 1 Step -1
If Mid$(sFile, lCount, 1) = "\" Then
GetFolder = Left$(sFile, lCount)
Exit Function
End If
Next
GetFolder = vbNullString
End Function
Public Sub EnablePlayUI(fEnable As Boolean)
'Enable/Disable the buttons
If fEnable Then
chkLoop.Enabled = True
cmdStop.Enabled = False
cmdPlay.Enabled = True
cmdOpen.Enabled = True
cmdPlay.SetFocus
Else
chkLoop.Enabled = False
cmdStop.Enabled = True
cmdPlay.Enabled = False
cmdOpen.Enabled = False
cmdStop.SetFocus
End If
End Sub
Private Sub sldTempo_Click()
'Update the tempo now
dmp.SetMasterTempo (sldTempo.Value / 10)
End Sub
Private Sub sldTempo_Scroll()
sldTempo_Click
End Sub
Private Sub sldVolume_Click()
sldVolume_Scroll
End Sub
Private Sub sldVolume_Scroll()
'Update the volume
dmp.SetMasterVolume sldVolume.Value
End Sub
Private Sub EnableTempoControl(ByVal fEnable As Boolean)
'If this is a wave file, turn off tempo control
fraTempo.Enabled = fEnable
sldTempo.Enabled = fEnable
lbl(4).Enabled = fEnable
lbl(5).Enabled = fEnable
lbl(6).Enabled = fEnable
If Not fEnable Then
sldTempo.TickStyle = sldNoTicks
Else
sldTempo.TickStyle = sldBottomRight
End If
End Sub

View File

@@ -0,0 +1,80 @@
//-----------------------------------------------------------------------------
//
// Sample Name: VB PlayAudio Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
//
//-----------------------------------------------------------------------------
Description
===========
The PlayAudio sample shows how to load a segment and play it on an
audiopath, how to use DirectMusic notifications, and how to change
global performance parameters.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\PlayAudio
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\Bin
User's Guide
============
Play the default segment, or load another wave, MIDI, or DirectMusic
Producer segment file by clicking Audio File. Adjust the tempo and
volume by using the sliders
Programming Notes
=================
This is how the sample works:
* Upon Form_Load
1. Create the DirectMusic objects.
2. Initialize DirectMusic. This creates a default standard audio path
3. Call DirectMusicPerformance8.AddNotificationType passing in
DMUS_NOTIFY_ON_SEGMENT. This will make DirectMusic tell us about any
segment notifications that come in. This is needed to by this
sample to know when the segment has ended. However DirectMusic
games may not care when the segment has ended.
4. Create a DirectX event, dmEvent. This will be used by DirectMusic
to signal the app whenever a DirectMusic notification comes in.
5. Call DirectMusicPerformance8.SetNotificationHandle passing
in the DirectX event, dmEvent. This tells DirectMusic
to signal this event when a notification is available.
* When "Open File" is clicked. See cmdOpen_Click()
1. Get the file name from the common dialog.
2. Get rid of any old segment.
3. Call DirectMusicLoader8.SetSearchDirectory.
This will tell DirectMusic where to look for files that
are referenced inside of segments.
4. Call DirectMusicLoader8.LoadSegmentFromFile
5. If the file is a pure MIDI file then it calls
DirectMusicSegment8.SetStandardMidiFile This makes
sure that patch changes are handled correctly.
6. Calls DirectMusicSegment8.Download
this will download the segment's bands to the synthesizer.
Some apps may want to wait before calling this to because
the download allocates memory for the instruments. The
more instruments currently downloaded, the more memory
is in use by the synthesizer.
* When "Play" is clicked. See cmdPlay_Click()
1. If the UI says the sound should be looped, then call
DirectMusicSegment8.SetRepeats passing in INFINITE,
otherwise call DirectMusicSegment8.SetRepeats passing in 0.
2. Call DirectMusicPerformance8.PlaySegmentEx()
* Upon a DirectMusic notification. See DirectXEvent8_DXCallback().
This sample wants to know if the primary segment has stopped playing
so it can updated the UI so tell the user that they can play
the sound again.
1. Call IDirectMusicPerformance8.GetNotificationPMSG
2. Switch off the pPMsg->dwNotificationOption. This sample
only handles it if its a DMUS_NOTIFICATION_SEGEND. This tells
us that segment has ended.

View File

@@ -0,0 +1,33 @@
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
Form=frmAudio.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
Startup="frmAudio"
ExeName32="vb_PlayAudio.exe"
Command32=""
Name="vbPlayAudio"
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

View File

@@ -0,0 +1,471 @@
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmPlayMotif
BorderStyle = 3 'Fixed Dialog
Caption = "vb PlayMotif"
ClientHeight = 4365
ClientLeft = 45
ClientTop = 330
ClientWidth = 5955
Icon = "frmPlayMotif.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4365
ScaleWidth = 5955
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog cdlOpen
Left = 5160
Top = 1080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "Open Segment File"
End
Begin VB.TextBox txtStatus
BackColor = &H8000000F&
Height = 315
Left = 1320
Locked = -1 'True
TabIndex = 16
Top = 600
Width = 4515
End
Begin VB.TextBox txtSegment
BackColor = &H8000000F&
Height = 315
Left = 1320
Locked = -1 'True
TabIndex = 14
Top = 180
Width = 4515
End
Begin VB.OptionButton optMeasure
Caption = "Measure"
Height = 255
Left = 4800
TabIndex = 13
Top = 3600
Value = -1 'True
Width = 975
End
Begin VB.OptionButton optBeat
Caption = "Beat"
Height = 255
Left = 4020
TabIndex = 12
Top = 3600
Width = 675
End
Begin VB.OptionButton optGrid
Caption = "Grid"
Height = 255
Left = 3180
TabIndex = 11
Top = 3600
Width = 735
End
Begin VB.OptionButton optImmediate
Caption = "Immediate"
Height = 255
Left = 2040
TabIndex = 10
Top = 3600
Width = 1035
End
Begin VB.OptionButton optDefault
Caption = "Default"
Height = 255
Left = 1080
TabIndex = 9
Top = 3600
Width = 855
End
Begin VB.ListBox lstMotif
Height = 1815
Left = 60
TabIndex = 7
Top = 1680
Width = 5775
End
Begin VB.CheckBox chkLoop
Caption = "Loop Segment"
Height = 195
Left = 120
TabIndex = 5
Top = 1140
Width = 1395
End
Begin VB.CommandButton cmdStop
Caption = "&Stop"
Height = 315
Left = 2700
TabIndex = 4
Top = 1080
Width = 1095
End
Begin VB.CommandButton cmdPlay
Caption = "&Play"
Height = 315
Left = 1560
TabIndex = 3
Top = 1080
Width = 1095
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 315
Left = 4740
TabIndex = 2
Top = 3960
Width = 1095
End
Begin VB.CommandButton cmdPlayMotif
Caption = "Play &Motif"
Height = 315
Left = 60
TabIndex = 1
Top = 3960
Width = 1095
End
Begin VB.CommandButton cmdSegment
Caption = "Segment &File"
Default = -1 'True
Height = 315
Left = 120
TabIndex = 0
Top = 180
Width = 1095
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Status:"
Height = 195
Index = 2
Left = 120
TabIndex = 15
Top = 660
Width = 1035
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Align Option:"
Height = 195
Index = 1
Left = 60
TabIndex = 8
Top = 3600
Width = 915
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Select a Motif:"
Height = 195
Index = 0
Left = 60
TabIndex = 6
Top = 1440
Width = 4635
End
End
Attribute VB_Name = "frmPlayMotif"
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: frmPlayMotif.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Implements DirectXEvent8
Private Type Motif_Node
Motif As DirectMusicSegment8
Name As String
ListIndex As Long
End Type
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private dx As New DirectX8
Private dmPerf As DirectMusicPerformance8
Private dmLoader As DirectMusicLoader8
Private dmSegment As DirectMusicSegment8
Private mlSeg As Long
Private moMotifs() As Motif_Node
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPlay_Click()
If chkLoop.Value = vbChecked Then
dmSegment.SetRepeats INFINITE
Else
dmSegment.SetRepeats 0
End If
dmPerf.PlaySegmentEx dmSegment, 0, 0
EnablePlayUI False
End Sub
Private Sub cmdPlayMotif_Click()
Dim lFlags As CONST_DMUS_SEGF_FLAGS
lFlags = DMUS_SEGF_SECONDARY
If optBeat.Value Then lFlags = lFlags Or DMUS_SEGF_BEAT
If optDefault.Value Then lFlags = lFlags Or DMUS_SEGF_DEFAULT
If optGrid.Value Then lFlags = lFlags Or DMUS_SEGF_GRID
If optImmediate.Value Then lFlags = lFlags Or DMUS_SEGF_SECONDARY
If optMeasure.Value Then lFlags = lFlags Or DMUS_SEGF_MEASURE
dmPerf.PlaySegmentEx moMotifs(lstMotif.ListIndex).Motif, lFlags, 0
End Sub
Private Sub cmdSegment_Click()
Static sCurDir As String
Static lFilter As Long
'We want to open a file now
cdlOpen.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
cdlOpen.FilterIndex = lFilter
cdlOpen.Filter = "Segment Files (*.sgt)|*.sgt"
cdlOpen.FileName = vbNullString
If sCurDir = vbNullString Then
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
Dim sWindir As String
sWindir = Space$(255)
If GetWindowsDirectory(sWindir, 255) = 0 Then
'We couldn't get the windows folder for some reason, use the c:\
cdlOpen.InitDir = "C:\"
Else
Dim sMedia As String
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
If Right$(sWindir, 1) = "\" Then
sMedia = sWindir & "Media"
Else
sMedia = sWindir & "\Media"
End If
If Dir$(sMedia, vbDirectory) <> vbNullString Then
cdlOpen.InitDir = sMedia
Else
cdlOpen.InitDir = sWindir
End If
End If
Else
cdlOpen.InitDir = sCurDir
End If
On Local Error GoTo ClickedCancel
cdlOpen.CancelError = True
cdlOpen.ShowOpen ' Display the Open dialog box
'Save the current information
sCurDir = GetFolder(cdlOpen.FileName)
'Set the search folder to this one so we can auto download anything we need
dmLoader.SetSearchDirectory sCurDir
lFilter = cdlOpen.FilterIndex
On Local Error GoTo NoLoadSegment
'Before we load the segment stop one if it's playing
cmdStop_Click
'Now let's load the segment
LoadSegment cdlOpen.FileName
Exit Sub
NoLoadSegment:
UpdateStatus "Couldn't load this segment"
ClickedCancel:
End Sub
Private Sub cmdStop_Click()
'Stop the segment
dmPerf.StopEx dmSegment, 0, 0
EnablePlayUI True
UpdateStatus "User pressed stop."
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
'Here we will handle the DMusic callbacks
Dim dmNotification As DMUS_NOTIFICATION_PMSG
Dim oState As DirectMusicSegmentState8
Dim oSeg As DirectMusicSegment8
Dim lCount As Long
On Error GoTo FailedOut
'Process all events
Do While dmPerf.GetNotificationPMSG(dmNotification)
If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGEND Then 'The segment has ended
'First we need to figure out which segment
Set oState = dmNotification.User 'The user field holds the segment state on segment notifications
Set oSeg = oState.GetSegment 'Get the segment from the state
'Is this the primary segment?
If oSeg Is dmSegment Then 'Yup
UpdateStatus "Primary Segment stopped playing."
EnablePlayUI True
Else
'Go through all of the other segments
For lCount = 0 To UBound(moMotifs)
If oSeg Is moMotifs(lCount).Motif Then
UpdateStatus moMotifs(lCount).Name & " motif stopped playing."
'Now update the listbox
lstMotif.List(moMotifs(lCount).ListIndex) = moMotifs(lCount).Name
End If
Next
End If
End If
If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGSTART Then 'The segment has started
'First we need to figure out which segment
Set oState = dmNotification.User 'The user field holds the segment state on segment notifications
Set oSeg = oState.GetSegment 'Get the segment from the state
'Is this the primary segment?
If oSeg Is dmSegment Then 'Yup
UpdateStatus "Primary Segment started playing."
Else
'Go through all of the other segments
For lCount = 0 To UBound(moMotifs)
If oSeg Is moMotifs(lCount).Motif Then
UpdateStatus moMotifs(lCount).Name & " motif started playing."
'Now update the listbox
lstMotif.List(moMotifs(lCount).ListIndex) = moMotifs(lCount).Name & " (Playing)"
End If
Next
End If
End If
Loop
Exit Sub
FailedOut:
MsgBox "Error processing this Notification", vbOKOnly Or vbInformation, "Cannot Process."
End Sub
Private Sub Form_Load()
Me.Show
InitAudio
End Sub
Private Sub InitAudio()
On Error GoTo FailedInit
Dim dma As DMUS_AUDIOPARAMS
Dim sMedia As String
'Create our objects
Set dmPerf = dx.DirectMusicPerformanceCreate
Set dmLoader = dx.DirectMusicLoaderCreate
'Set up a default audio path
dmPerf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
'Create an event handle
mlSeg = dx.CreateEvent(Me)
dmPerf.AddNotificationType DMUS_NOTIFY_ON_SEGMENT
dmPerf.SetNotificationHandle mlSeg
'Don't let them play a motif yet
cmdPlayMotif.Enabled = False
'Now let's load our default segment
sMedia = FindMediaDir("sample.sgt")
dmLoader.SetSearchDirectory sMedia
If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
LoadSegment sMedia & "sample.sgt"
EnablePlayMotif False
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End Sub
Private Sub Cleanup()
On Error Resume Next
'Get rid of our event
dmPerf.RemoveNotificationType DMUS_NOTIFY_ON_SEGMENT
dx.DestroyEvent mlSeg
'Unload our segment
If Not (dmSegment Is Nothing) Then dmSegment.Unload dmPerf.GetDefaultAudioPath
Set dmSegment = Nothing
'Get rid of our motifs
ReDim moMotifs(0)
'Cleanup
dmPerf.CloseDown
Set dmPerf = Nothing
Set dmLoader = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End Sub
Private Function GetFolder(ByVal sFile As String) As String
Dim lCount As Long
For lCount = Len(sFile) To 1 Step -1
If Mid$(sFile, lCount, 1) = "\" Then
GetFolder = Left$(sFile, lCount)
Exit Function
End If
Next
GetFolder = vbNullString
End Function
Public Sub EnablePlayUI(fEnable As Boolean)
'Enable/Disable the buttons
If fEnable Then
chkLoop.Enabled = True
cmdStop.Enabled = False
cmdPlay.Enabled = True
cmdSegment.Enabled = True
cmdPlay.SetFocus
Else
chkLoop.Enabled = False
cmdStop.Enabled = True
cmdPlay.Enabled = False
cmdSegment.Enabled = False
cmdStop.SetFocus
End If
If lstMotif.ListCount > 0 And lstMotif.ListIndex <> -1 Then
EnablePlayMotif Not fEnable
Else
EnablePlayMotif False
End If
End Sub
Public Sub EnablePlayMotif(ByVal fEnable As Boolean)
cmdPlayMotif.Enabled = fEnable
End Sub
Private Sub LoadSegment(ByVal sFile As String)
Dim lTrack As Long, lCount As Long
Dim oStyle As DirectMusicStyle8
Dim lTotalStyle As Long, lTempTotalStyle As Long
On Error GoTo LeaveProc
ReDim moMotifs(0)
lstMotif.Clear
Set dmSegment = dmLoader.LoadSegment(sFile)
dmSegment.Download dmPerf.GetDefaultAudioPath
txtSegment.Text = sFile
EnablePlayUI True
'Now let's get the motifs in this segment
Do While True
Set oStyle = dmSegment.GetStyle(lTrack)
lTotalStyle = lTotalStyle + oStyle.GetMotifCount - 1
ReDim Preserve moMotifs(lTotalStyle)
For lCount = 0 To oStyle.GetMotifCount - 1
lstMotif.AddItem oStyle.GetMotifName(lCount)
Set moMotifs(lTempTotalStyle + lCount).Motif = oStyle.GetMotif(oStyle.GetMotifName(lCount))
moMotifs(lTempTotalStyle + lCount).Name = oStyle.GetMotifName(lCount)
moMotifs(lTempTotalStyle + lCount).ListIndex = lstMotif.ListCount - 1
Next
lTrack = lTrack + 1
lTempTotalStyle = lTotalStyle
Loop
LeaveProc:
If lstMotif.ListCount > 0 Then lstMotif.ListIndex = 0
UpdateStatus "File loaded."
End Sub
Private Sub UpdateStatus(sStat As String)
txtStatus.Text = sStat
End Sub

View File

@@ -0,0 +1,85 @@
//-----------------------------------------------------------------------------
//
// Sample Name: VB PlayMotif Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
//
//-----------------------------------------------------------------------------
Description
===========
The PlayMotif sample demonstrates how a motif played as a secondary
segment can be aligned to the rhythm of the primary segment in various ways.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\PlayMotif
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\Bin
User's Guide
============
Play the default segment, or load another DirectMusic Producer segment
that contains motifs. Select one of the patterns in the list box and
one of the Align Option buttons, and then click Play Motif. Note how
the motif does not begin playing until an appropriate boundary in the
primary segment has been reached.
Programming Notes
=================
The PlayMotif sample is very similar in form to the PlayAudio sample. For
detailed programming notes on the basics this sample, refer to Programming
Notes section of the PlayAudio sample.
The PlayMotif differs by letting the user play any of motifs contained
inside the segment. Here's how:
* When loading the file it does the same steps as the PlayAudio
sample, but also:
1. It loops thru each style in the segment, searching it for
motifs. It calls DirectMusicSegment8.GetStyle passing
an increasing style index to get each of the styles. When
this returns error then there are no more styles.
2. For each style, it calls DirectMusicStyle.GetMotifCount.
It then loops through each Motif, and stores the motif name
in the list box.
3. With the motif name it calls DirectMusicStyle::GetMotif
to get a DirectMusicSegment pointer to the motif, and
stores this for later use.
* When "Play Motif" is clicked. See cmdPlayMotif_Click().
1. It gets the desired alignment option from the UI.
2. It gets the selected motif from our interal list.
3. It calls DirectMusicPerformance::PlaySegmentEx passing in
the motif's DirectMusicSegment and flags which have
DMUS_SEGF_SECONDARY as well as any alignment option.
* When DirectMusic notifications occur, it is similar to PlayAudio but
now the app also takes note of any motif starting or stopping and
updates the play count. If the play count is greater than zero then
it updates the UI to show that the motif is playing. Most games
would not need this functionality, but here's how its done:
See DirectXEvent8_DXCallback.
- Call DirectMusicPerformance8::GetNotificationPMsg.
- Check if the pPMsg->lNotificationOption.
- If it is a DMUS_NOTIFICATION_SEGSTART. This tells
us that a segment has ended. It may be for a motif or the primary
or some embedded segment in the primary segment.
- If it is a DMUS_NOTIFICATION_SEGEND. This tells
us that a segment has ended. It may be for a motif or the primary
or some embedded segment in the primary segment.
- For either SEGSTART or SEGEND the code is similar:
1. Get a DirectMusicSegmentState8 from pPMsg.User.
2. Using the IDirectMusicSegmentState8, call GetSegment to
get a DirectMusicSegment of the segment it refers to.
This call may fail is the segment may have gone away before this
notification was handled.
4. Compare this segment to the primary segment to see if this was
the primary segment. If it was, then update the UI. If its not
then compare it to each of the motif's segments. If a match is
found update the UI accordingly.
5. Cleanup all the interfaces.

View File

@@ -0,0 +1,32 @@
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
Form=frmPlayMotif.frm
Module=MediaDir; ..\..\common\media.bas
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Startup="frmPlayMotif"
Command32=""
Name="vbPlayMotif"
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

View File

@@ -0,0 +1,378 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSimple
BorderStyle = 3 'Fixed Dialog
Caption = "Simple Audio Path"
ClientHeight = 4380
ClientLeft = 45
ClientTop = 330
ClientWidth = 7245
Icon = "frmSimple.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4380
ScaleWidth = 7245
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame3
Caption = "Description"
Height = 1695
Left = 3660
TabIndex = 17
Top = 2220
Width = 3495
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = $"frmSimple.frx":0442
Height = 1335
Index = 4
Left = 60
TabIndex = 18
Top = 240
Width = 3375
End
End
Begin VB.Frame Frame2
Caption = "3D Positioning of AudioPath"
Height = 1695
Left = 60
TabIndex = 6
Top = 2220
Width = 3555
Begin MSComctlLib.Slider sldX
Height = 195
Left = 300
TabIndex = 10
Top = 420
Width = 2595
_ExtentX = 4577
_ExtentY = 344
_Version = 393216
LargeChange = 2
Min = -20
Max = 20
TickFrequency = 4
End
Begin MSComctlLib.Slider sldY
Height = 195
Left = 300
TabIndex = 11
Top = 840
Width = 2595
_ExtentX = 4577
_ExtentY = 344
_Version = 393216
LargeChange = 2
Min = -20
Max = 20
TickFrequency = 4
End
Begin MSComctlLib.Slider SldZ
Height = 195
Left = 300
TabIndex = 12
Top = 1260
Width = 2535
_ExtentX = 4471
_ExtentY = 344
_Version = 393216
LargeChange = 2
Min = -20
Max = 20
TickFrequency = 4
End
Begin VB.Label lblZ
Alignment = 2 'Center
BackStyle = 0 'Transparent
Height = 255
Left = 2940
TabIndex = 21
Top = 1260
Width = 555
End
Begin VB.Label lblY
Alignment = 2 'Center
BackStyle = 0 'Transparent
Height = 255
Left = 2940
TabIndex = 20
Top = 840
Width = 555
End
Begin VB.Label lblX
Alignment = 2 'Center
BackStyle = 0 'Transparent
Height = 255
Left = 2940
TabIndex = 19
Top = 420
Width = 555
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Z"
Height = 255
Index = 2
Left = 120
TabIndex = 9
Top = 1260
Width = 135
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Y"
Height = 255
Index = 1
Left = 120
TabIndex = 8
Top = 840
Width = 135
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "X"
Height = 255
Index = 0
Left = 120
TabIndex = 7
Top = 420
Width = 135
End
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "E&xit"
Height = 375
Left = 5760
TabIndex = 5
Top = 3960
Width = 1395
End
Begin VB.Frame Frame1
Caption = "DirectMusic Segments"
Height = 1995
Left = 60
TabIndex = 0
Top = 180
Width = 7095
Begin VB.CommandButton cmdSeg
Caption = "Rude Awakening"
Height = 315
Index = 3
Left = 120
TabIndex = 4
Top = 1500
Width = 1395
End
Begin VB.CommandButton cmdSeg
Caption = "Mumble"
Height = 315
Index = 2
Left = 120
TabIndex = 3
Top = 1080
Width = 1395
End
Begin VB.CommandButton cmdSeg
Caption = "Snore"
Height = 315
Index = 1
Left = 120
TabIndex = 2
Top = 660
Width = 1395
End
Begin VB.CommandButton cmdSeg
Caption = "Lullaby"
Height = 315
Index = 0
Left = 120
TabIndex = 1
Top = 240
Width = 1395
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Segment file. Stops all sound on audio path. Plays as primary segment."
Height = 255
Index = 3
Left = 1620
TabIndex = 16
Top = 1560
Width = 5295
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Wave file. Overlaps if pressed twice. Plays as secondary segment."
Height = 255
Index = 2
Left = 1620
TabIndex = 15
Top = 1140
Width = 5295
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Segment file. Overlaps if pressed twice. Plays as secondary segment."
Height = 255
Index = 1
Left = 1620
TabIndex = 14
Top = 720
Width = 5295
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Segment file. Starts over if pressed twice. Plays as primary segment."
Height = 255
Index = 0
Left = 1620
TabIndex = 13
Top = 300
Width = 5295
End
End
End
Attribute VB_Name = "frmSimple"
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: frmSimple.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private dx As New DirectX8
Private dmPerf As DirectMusicPerformance8
Private dmLoad As DirectMusicLoader8
Private dmPath As DirectMusicAudioPath8
Private dmSeg(0 To 3) As DirectMusicSegment8
Private sMediaFolder As String
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSeg_Click(Index As Integer)
If Not (dmSeg(Index) Is Nothing) Then
If Index = 0 Then
'Lullaby theme. This should play as a primary segment.
dmPerf.PlaySegmentEx dmSeg(Index), DMUS_SEGF_DEFAULT, 0, Nothing, dmPath
ElseIf Index = 3 Then
'Rude awakening. Notice that this also passes the audio path in pFrom, indicating that
'all segments currently playing on the audio path should be stopped at the exact time
'this starts.
dmPerf.PlaySegmentEx dmSeg(Index), 0, 0, dmPath, dmPath
ElseIf Index < 3 Then
'Sound effects. These play as secondary segments so they can be triggered multiple
'times and will layer on top.
dmPerf.PlaySegmentEx dmSeg(Index), DMUS_SEGF_SECONDARY Or DMUS_SEGF_DEFAULT, 0, , dmPath
End If
End If
End Sub
Private Sub Form_Load()
SetPosition
InitAudio
End Sub
Private Sub InitAudio()
On Error GoTo FailedInit
Dim dma As DMUS_AUDIOPARAMS
'Create our objects
Set dmPerf = dx.DirectMusicPerformanceCreate
Set dmLoad = dx.DirectMusicLoaderCreate
'Initialize our audio
dmPerf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dma
Set dmPath = dmPerf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_3D, 64, True)
sMediaFolder = FindMediaDir("audiopath1.sgt")
If sMediaFolder = vbNullString Then sMediaFolder = AddDirSep(CurDir)
dmLoad.SetSearchDirectory sMediaFolder
'Now load the segments
Set dmSeg(0) = dmLoad.LoadSegment(sMediaFolder & "audiopath1.sgt")
Set dmSeg(1) = dmLoad.LoadSegment(sMediaFolder & "audiopath2.sgt")
Set dmSeg(2) = dmLoad.LoadSegment(sMediaFolder & "audiopath3.wav")
Set dmSeg(3) = dmLoad.LoadSegment(sMediaFolder & "audiopath4.sgt")
'Download our segments onto the audio path
Dim lCount As Long
For lCount = 0 To 3
dmSeg(lCount).Download dmPath
Next
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End Sub
Private Sub Cleanup()
Dim lCount As Long
'Unload all of our segments
For lCount = 0 To 3
If Not (dmSeg(lCount) Is Nothing) Then
dmSeg(lCount).Unload dmPath
End If
Set dmSeg(lCount) = Nothing
Next
'Destroy everything
Set dmPath = Nothing
dmPerf.CloseDown
Set dmPerf = Nothing
Set dmLoad = Nothing
End Sub
Private Sub SetPosition()
Dim dsb As DirectSound3DBuffer8
If Not (dmPath Is Nothing) Then
'First, get the 3D interface from the buffer by using GetObjectInPath.
Set dsb = dmPath.GetObjectinPath(DMUS_PCHANNEL_ALL, DMUS_PATH_BUFFER, 0, GUID_ALL, 0, IID_DirectSound3DBuffer)
If Not (dsb Is Nothing) Then
'Then, set the coordinates
dsb.SetPosition sldX.Value, sldY.Value, SldZ.Value, DS3D_IMMEDIATE
End If
End If
'Update the text boxes as well
lblX.Caption = CStr(sldX.Value)
lblY.Caption = CStr(sldY.Value)
lblZ.Caption = CStr(SldZ.Value)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End Sub
'Update the 3D Positions when any of the scroll bars move
Private Sub sldX_Click()
SetPosition
End Sub
Private Sub sldX_Scroll()
SetPosition
End Sub
Private Sub sldY_Click()
SetPosition
End Sub
Private Sub sldY_Scroll()
SetPosition
End Sub
Private Sub SldZ_Click()
SetPosition
End Sub
Private Sub SldZ_Scroll()
SetPosition
End Sub

View File

@@ -0,0 +1,58 @@
//-----------------------------------------------------------------------------
//
// Sample Name: SimpleAudioPath Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
//
//-----------------------------------------------------------------------------
Description
===========
The AudioPath sample demonstrates how different sounds can be played
on an audiopath, and how the parameters of all sounds are affected
by changes made on the audiopath.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\SimpleAudioPath
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectMusic\Bin
User's Guide
============
Click Lullaby, Snore, and Mumble to play different sounds. Adjust the
3-D position of the sounds by using the sliders. Click Rude Awakening
to play a different sound and stop all other sounds.
Programming Notes
=================
The AudioPath differs by showing some of the various uses of an
audiopath. Here's how:
* Upon init.
1. Calls DirectMusicPerformance8::CreateStandardAudioPath passing
in DMUS_APATH_DYNAMIC_3D to create a 3D audiopath.
2. Loads all of the files needed for this sample.
* Upon 3D positoin slider change. See SetPosition
1. Calls DirectMusicAudioPath.GetObjectInPath on the 3D audiopath to
get the DirectSound3DBuffer from it.
2. Calls DirectSound3DBuffer.SetPosition to set a new 3D position on
the buffer of the audiopath.
* Upon button click. See cmdSeg_Click.
- If its the first button, "Lullaby", this plays the primary segment
on the 3D audiopath by calling PlaySegmentEx passing in
DMUS_SEGF_DEFAULT and the 3D audiopath.
- If its the second or third button, this plays a secondary segment
on the 3D audiopath by calling PlaySegmentEx passing in
DMUS_SEGF_DEFAULT or DMUS_SEGF_SECONDARY and the 3D audiopath.
- If its the forth button, "Rude Awakening", this plays a primary segment
on the 3D audiopath by calling PlaySegmentEx passing in
the 3D audiopath, and setting the pFrom to the 3D audiopath.
This causes all currently playing segments to stop when this one starts.

View File

@@ -0,0 +1,32 @@
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
Form=frmSimple.frm
Module=MediaDir; ..\..\common\media.bas
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
Startup="frmSimple"
Command32=""
Name="vbSimpleAudioPath"
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

View File

@@ -0,0 +1,129 @@
VERSION 5.00
Begin VB.Form frmAudTut1
Caption = "Audio Tutorial 1"
ClientHeight = 1320
ClientLeft = 60
ClientTop = 345
ClientWidth = 5460
Icon = "audtut1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 1320
ScaleWidth = 5460
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdClose
Caption = "Close"
Default = -1 'True
Height = 375
Left = 4260
TabIndex = 0
Top = 900
Width = 1035
End
Begin VB.Image Image1
Height = 480
Left = 120
Picture = "audtut1.frx":0442
Top = 120
Width = 480
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
Height = 255
Index = 2
Left = 600
TabIndex = 3
Top = 300
Width = 4800
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S."
Height = 255
Index = 1
Left = 600
TabIndex = 2
Top = 540
Width = 4755
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "DirectMusic Segment Tutorial"
Height = 255
Index = 0
Left = 600
TabIndex = 1
Top = 60
Width = 2655
End
End
Attribute VB_Name = "frmAudTut1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: audTut1.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
' Our DX variables
Private dx As New DirectX8
'We need a loader variable
Private dml As DirectMusicLoader8
'We need our performance object
Private dmp As DirectMusicPerformance8
'We also need our DMusic segment
Private seg As DirectMusicSegment8
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim dmA As DMUS_AUDIOPARAMS
'Get our loader and performance
Set dml = dx.DirectMusicLoaderCreate
Set dmp = dx.DirectMusicPerformanceCreate
'We will put in error checking here in case we can't init DMusic
'ie, if there is no sound card
On Error GoTo FailedInit
'Initialize our DMusic Audio with a default environment
dmp.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, Nothing, DMUS_APATH_SHARED_STEREOPLUSREVERB, 64
'Here we will load our audio file. We could load a wave file,
'a midi file, and rmi file, or a DMusic segment. For this
'tutorial we will load a segment.
'Before we load our segment, set our search directory
dml.SetSearchDirectory FindMediaDir("sample.sgt")
'Now we can load our segment
Set seg = dml.LoadSegment("sample.sgt")
'Download our segment to the default audio path (created during our call to InitAudio)
seg.Download dmp.GetDefaultAudioPath
'Play our segment from the beginning
dmp.PlaySegmentEx seg, 0, 0
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
'Stops everything playing on the audio path
dmp.StopEx dmp.GetDefaultAudioPath, 0, 0
'Destroy all of our objects
Set seg = Nothing
'Closedown the performance object (we should always do this).
dmp.CloseDown
'Destroy the rest of our objects
Set dmp = Nothing
Set dml = Nothing
Set dx = Nothing
End Sub

View File

@@ -0,0 +1,30 @@
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
Form=audtut1.frm
Module=MediaDir; ..\..\..\common\media.bas
Startup="frmAudTut1"
Command32=""
Name="AudioTutorial1"
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
ThreadPerObject=0
MaxNumberOfThreads=1

View File

@@ -0,0 +1,337 @@
VERSION 5.00
Begin VB.Form AudTut2
BorderStyle = 3 'Fixed Dialog
Caption = "Audio Tutorial 2"
ClientHeight = 3405
ClientLeft = 45
ClientTop = 330
ClientWidth = 3390
Icon = "audtut2.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3405
ScaleWidth = 3390
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdStop
Caption = "Stop"
Height = 375
Left = 1718
TabIndex = 6
Top = 2940
Width = 855
End
Begin VB.CommandButton cmdPlay
Caption = "Play"
Height = 375
Left = 818
TabIndex = 5
Top = 2940
Width = 855
End
Begin VB.Frame fraSound
Caption = "Sound Type"
Height = 1275
Left = 60
TabIndex = 4
Top = 1560
Width = 3255
Begin VB.OptionButton optSeg
Caption = "DirectMusic Segment"
Height = 255
Left = 180
TabIndex = 9
Top = 900
Width = 2655
End
Begin VB.OptionButton optMid
Caption = "Midi File"
Height = 255
Left = 180
TabIndex = 8
Top = 600
Width = 1815
End
Begin VB.OptionButton optWave
Caption = "Wave File"
Height = 255
Left = 180
TabIndex = 7
Top = 300
Value = -1 'True
Width = 1815
End
End
Begin VB.HScrollBar scrlPan
Height = 255
LargeChange = 2
Left = 1080
Max = 10
Min = -10
TabIndex = 1
Top = 1200
Width = 2235
End
Begin VB.HScrollBar scrlVol
Height = 255
LargeChange = 20
Left = 1080
Max = 0
Min = -5000
SmallChange = 500
TabIndex = 0
Top = 840
Width = 2235
End
Begin VB.Image Image1
Height = 480
Left = 120
Picture = "audtut2.frx":0442
Top = 180
Width = 480
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
Height = 435
Index = 2
Left = 660
TabIndex = 11
Top = 300
Width = 2655
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Audio Tutorial 2"
Height = 255
Index = 0
Left = 660
TabIndex = 10
Top = 60
Width = 2655
End
Begin VB.Label Label2
Caption = "Pan"
Height = 255
Left = 120
TabIndex = 3
Top = 1200
Width = 975
End
Begin VB.Label Label1
Caption = "Volume"
Height = 255
Left = 120
TabIndex = 2
Top = 840
Width = 1095
End
End
Attribute VB_Name = "AudTut2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: audTut2.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'===========================================================
'DirectX Audio Tutorial 2
'This tutorial will show you how to load a wave, midi, or
'segment file in to an audio path, and then play back the
'file. It will also show how to get an object from an audio
'path and manipulate it
'===========================================================
Option Explicit
Private dx As DirectX8
Private dml As DirectMusicLoader8
Private dmp As DirectMusicPerformance8
Private dmSeg As DirectMusicSegment8
Private dmSegState As DirectMusicSegmentState8
Private dmPath As DirectMusicAudioPath8
Private mlOffset As Long
Private MediaPath As String
Private Sub Form_Load()
Dim dmA As DMUS_AUDIOPARAMS
MediaPath = FindMediaDir("tuta.wav")
'===========================================
'- Step 1 initialize the DirectX objects.
'===========================================
On Local Error Resume Next
Set dx = New DirectX8
Set dml = dx.DirectMusicLoaderCreate
Set dmp = dx.DirectMusicPerformanceCreate
dml.SetSearchDirectory MediaPath
'========================================================
'- Step 2
' Now we can init our audio environment, and check for any errors
' if a sound card is not present or DirectX is not
' installed. The 'On Local Error Resume Next'
' statement allows us to check error values immediately
' after execution. The error number 0 indicates no error.
'========================================================
dmp.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA
If Err.Number <> 0 Then
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
Exit Sub
End If
'===========================================================
'- Step 3 Now we can set up our Audio path which will play
' the sounds.
'============================================================
Set dmPath = dmp.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_3D, 64, True)
End Sub
Sub LoadSound(sFile As String)
'========================================================================
'- Step 4 We can now load our audio file.
' But first we'll make sure the file exists
'=========================================================================
On Error Resume Next 'We'll check our error later in the app
If Dir$(sFile) = vbNullString Then
MsgBox "Unable to find " & sFile, vbOKOnly Or vbCritical, "Not found."
Unload Me
End If
'Cleanup if there is already a segment loaded
If Not (dmSeg Is Nothing) Then
dmSeg.Unload dmPath
Set dmSeg = Nothing
End If
Set dmSeg = dml.LoadSegment(sFile)
If Right$(sFile, 4) = ".mid" Then dmSeg.SetStandardMidiFile
'========================================
'- Step 5 Download the segment, and make sure we have no errors
'========================================
dmSeg.Download dmPath
If Err.Number <> 0 Then
MsgBox "Unable to download segment.", vbOKOnly Or vbCritical, "No download."
Unload Me
End If
scrlPan_Change
scrlVol_Change
End Sub
'===============================
' Step 6 - PLAYING THE SOUNDS
'===============================
Private Sub cmdPlay_Click()
'=========================================================
' Make sure we've loaded our sound
'=========================================================
If dmSeg Is Nothing Then
If optWave.Value Then LoadSound MediaPath & "\tuta.wav"
If optMid.Value Then LoadSound MediaPath & "\tut.mid"
If optSeg.Value Then LoadSound MediaPath & "\sample.sgt"
End If
'================================================
'Plays the sound
'================================================
Set dmSegState = dmp.PlaySegmentEx(dmSeg, 0, 0, Nothing, dmPath)
End Sub
'==================
'- Step 7 Add Stop
'==================
Private Sub cmdStop_Click()
If dmSeg Is Nothing Then Exit Sub
dmp.StopEx dmSeg, 0, 0
mlOffset = 0
End Sub
'======================================================================
'- Step 8 Add Handler for setting the volume
'
' volume is set in db and ranges from -10000 to 0
' (direct sound doesn't amplify sounds just decreases their volume)
' because db is a log scale -6000 is almost the same as
' off and changes near zero have more effect on the volume
' than those at -6000. we use a -5000 to 0
'======================================================================
Private Sub scrlVol_Change()
'We can just set our volume
dmPath.SetVolume scrlVol.Value, 0
End Sub
Private Sub scrlVol_Scroll()
scrlVol_Change
End Sub
'===============================================================
'- Step 9 Add Handler for Pan
'===============================================================
Private Sub scrlPan_Change()
If dmSeg Is Nothing Then Exit Sub
'Now we need to get the corresponding Sound buffer, and make the call
Dim dsBuf As DirectSound3DBuffer8
Set dsBuf = dmPath.GetObjectinPath(DMUS_PCHANNEL_ALL, DMUS_PATH_BUFFER, 0, vbNullString, 0, "IID_IDirectSound3DBuffer")
dsBuf.SetPosition scrlPan.Value / 5, 0, 0, DS3D_IMMEDIATE
Set dsBuf = Nothing
End Sub
Private Sub scrlPan_Scroll()
scrlPan_Change
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Here we will cleanup any of our code
'First we should stop any currently playing sounds
If Not (dmSeg Is Nothing) Then dmp.StopEx dmSeg, 0, 0
Set dml = Nothing
Set dmSeg = Nothing
dmp.CloseDown
Set dmPath = Nothing
Set dmp = Nothing
Set dx = Nothing
End Sub
'If we click on any of the option buttons
'we should load the new a new segment
Private Sub optMid_Click()
cmdStop_Click
LoadSound MediaPath & "\tut.mid"
End Sub
Private Sub optSeg_Click()
cmdStop_Click
LoadSound MediaPath & "\sample.sgt"
End Sub
Private Sub optWave_Click()
cmdStop_Click
LoadSound MediaPath & "\tuta.wav"
End Sub

View File

@@ -0,0 +1,32 @@
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
Form=audtut2.frm
Module=MediaDir; ..\..\..\common\media.bas
Startup="AudTut2"
HelpFile=""
ExeName32="vb_AudTut2.exe"
Command32=""
Name="vbAudioTut2"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corp"
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
ThreadPerObject=0
MaxNumberOfThreads=1