[VB6] DirectSound Example - Printable Version

Code:
Option Explicit
Dim Dx As New DirectX7
Dim Ds As DirectSound
Dim DsBuffer1 As DirectSoundBuffer
Dim DsDesc As DSBUFFERDESC, DsWave As WAVEFORMATEX

Sub Initialise()
Set Ds = Dx.DirectSoundCreate("")
    If Err.Number <> 0 Then
        MsgBox "Unable to Continue, Error creating Directsound object."
        Exit Sub
    End If
Ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
DsDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC
DsWave.nFormatTag = WAVE_FORMAT_PCM 'Sound Must be PCM otherwise we get errors
DsWave.nChannels = 2    '1= Mono, 2 = Stereo
DsWave.lSamplesPerSec = 22050
DsWave.nBitsPerSample = 16 '16 =16bit, 8=8bit
DsWave.nBlockAlign = DsWave.nBitsPerSample / 8 * DsWave.nChannels
DsWave.lAvgBytesPerSec = DsWave.lSamplesPerSec * DsWave.nBlockAlign
End Sub

Public Function PlaySound(Bool As Boolean)
On Error GoTo ExitThis
If Bool = True Then
    Call Initialise
    Set DsBuffer1 = Ds.CreateSoundBufferFromFile("Y:\VB\Piano\b.wav", DsDesc, DsWave): DsBuffer1.Play DSBPLAY_DEFAULT
Else
    DsBuffer1.Stop: DsBuffer1.SetCurrentPosition 0
End If
ExitThis: Exit Function
End Function

Private Sub Command1_Click()
Call PlaySound(True)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call PlaySound(False)
End Sub