CodeItBetter Programming Another VB Programming Blog

'MultiMedia - How to play sound
Option Explicit
 
Public ds As DirectSound8    'Our DirectSound object
Const Max_Channels = 20      'The maximum number of simultanoes sounds
Dim dsBuffer() As DirectSoundSecondaryBuffer8    'Our SoundBuffers
Dim dsBufferUsed As Integer
 
Public Sub Add3DSound(ByVal nFilename As String, Optional lFrequency, Optional lPan, Optional lVolume)
    'First let's search a free buffer
    Dim nB As Long
    dsBufferUsed = dsBufferUsed + 1
    If dsBufferUsed > Max_Channels Then dsBufferUsed = 0
    nB = dsBufferUsed
 
    Dim dsBuf As DSBUFFERDESC
 
    'First clear the buffer
    If Not (dsBuffer(nB) Is Nothing) Then dsBuffer(nB).Stop
    Set dsBuffer(nB) = Nothing
 
    'Set some flags to the description
    dsBuf.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
    On Error Resume Next
    'Load file into buffer
    Set dsBuffer(nB) = ds.CreateSoundBufferFromFile(nFilename, dsBuf)
    If Err Then
        Debug.Print "Could not create soundbuffer (" & nFilename & ")"
        Exit Sub
    End If
 
    'If so, add "effects"
    If Not IsMissing(lFrequency) Then dsBuffer(nB).SetFrequency lFrequency
    '100-100000

    If Not IsMissing(lPan) Then dsBuffer(nB).SetPan lPan
    '-10000(left) 0(middle) +10000(right)

    If Not IsMissing(lVolume) Then dsBuffer(nB).SetVolume lVolume
    '-2500 - 0

    'let's play!
    dsBuffer(nB).Play DSBPLAY_DEFAULT
End Sub
 
Public Function Init(dx As DirectX8, nHWnd As Long) As Boolean
    'This one initializes our DSound objects
    On Local Error Resume Next
    Set ds = dx.DirectSoundCreate(vbNullString)    'Create a default DirectSound object

    'We couldn't create the DSound object.  End the app now
    If Err.Number <> 0 Then
        MsgBox "Could not initialize DirectSound." & vbCrLf & "This program will exit.", vbOKOnly Or vbInformation, "Exiting..."
        Init = False
        Exit Function
    End If
    'Set the coop level
    ds.SetCooperativeLevel nHWnd, DSSCL_PRIORITY
 
    ReDim dsBuffer(0 To Max_Channels)
 
    Init = True
    Debug.Print "ModDSOUND3D.Init successfully processed"
End Function
 
Public Sub Destroy()
    'This one kills our DS objects
    On Error Resume Next
    Dim n As Integer
 
    For n = 0 To UBound(dsBuffer)
        Set dsBuffer(n) = Nothing
    Next n
    Set ds = Nothing
    Debug.Print "ModDSOUND3D.Destroy successfully processed"
End Sub
 
'How can I use this:
Private Sub Form_Load()
    ModDSOUND3D.Init modDXGFX8.DirectX, Me.hwnd
    ModDSOUND3D.Add3DSound "sound.wav"
End Sub