'----------------------------------------------------------------
'Author: Dr. John A. Nyhart
'work : john_nyhart@medicalogic.com
'home : jnyhart@spessart.com
'web : www.spessart.com/users/jnyhart/john1.htm
'Posted:7/18/97
'
'How do I play a WAV file with VB?
'----------------------------------------------------------------
Sub PlayWav(SoundName As String)
Dim tmpSoundName As String
Dim wFlags%, X%
' declare statements (Place in a bas module.)
''**********************************
'#If Win32 Then
'Public Declare Function sndPlaySound& Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
'#Else
'Public Declare Function sndPlaySound% Lib "mmsystem.dll" (ByVal
lpszSoundName As String, ByVal uFlags As Integer)
'#End If 'WIN32
' **********************************
' WAV Sound values
'Global Const SND_SYNC = &H0
'Global Const SND_ASYNC = &H1
'Global Const SND_NODEFAULT = &H2
'Global Const SND_LOOP = &H8
'Global Const SND_NOSTOP = &H10
' **********************************
' *** pathWavFiles is a var with the subDir where
' the sound files are stored
tmpSoundName = pathWavFiles & SoundName
wFlags% = SND_ASYNC Or SND_NODEFAULT
X% = sndPlaySound(tmpSoundName, wFlags%)
End Sub
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'web : www.cadvision.com
'Posted:11/01/97
'
'How to play a .WAV file using API and the MMSYSTEM.DLL.
'Note: This has only been tested with VB 3 and VB 4-16, if you convert
'this for use with other versions please let me know.-Burt Abreu
'-------------------------------------------------------------------
' Declare this API and these Constants in a .BAS file:
Declare Function sndPlaySound% Lib "MMSYSTEM.DLL" (ByVal lpszSoundName$,
ByVal wFlags%)
Global Const SND_SYNC = &H0000
Global Const SND_ASYNC = &H0001
Global Const SND_NODEFAULT = &H0002
Global Const SND_LOOP = &H0008
Global Const SND_NOSTOP = &H0010
' Paramaters:
' lpszSoundName$
' Specifies the name of the sound to play. The function first
' searches the [sounds] section of the WIN.INI file for an entry
' with the specified name, and plays the associated waveform sound
' file. If no entry by this name exists, then it assumes the
' specified name is the name of a waveform sound file. If this
' parameter is NULL, any currently playing sound is stopped.
' That is, use a 0& to provide a NULL value.
' wFlags%
' Specifies options for playing the sound using one or more
' of the following flags:
' SND_SYNC: The sound is played synchronously and the function
' does not return until the sound ends.
' SND_ASYNC: The sound is played asynchronously and the function
' returns immediately after beginning the sound.
' SND_NODEFAULT: If the sound cannot be found, the function returns
' silently without playing the default sound.
' SND_LOOP: The sound will continue to play repeatedly until
' sndPlaySound is called again with the lpszSoundName$ parameter
' set to null.
' You must also specify the SND_ASYNC flag to loop sounds.
' SND_NOSTOP: If a sound is currently playing, the function will
' immediately return False without playing the requested sound.
' Add the following code to the appropriate routine:
Dim SoundName$
Dim wFlags%
Dim x%
SoundName$ = "c:\windows\tada.wav" ' The file to play
wFlags% = SND_ASYNC Or SND_NODEFAULT
x% = sndPlaySound(SoundName$,wFlags%)
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'web : www.cadvision.com
'Posted:11/01/97
'
'How to detect if a sound card exists on a system.
'Note: This has only been tested with VB 3 and VB 4-16, if you convert
'this for use with other versions please let me know.-Burt Abreu
'-------------------------------------------------------------------
' Here's how to detect if a sound card exists
' Declare this API
Declare Function auxGetNumDevs% Lib "MMSYSTEM" ()
' In the appropriate routine:
Dim i As Integer
i = auxGetNumDevs()
If i > 0 Then ' There is at least one sound card on the system
MsgBox "A Sound Card has been detected."
Else ' auxGetNumDevs returns a 0 if there is no sound card
MsgBox "There is no Sound Card on this system."
End If
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'web : www.cadvision.com
'Posted:11/01/97
'
'How to play an .AVI file using API and the MMSYSTEM.DLL..
'Note: This has only been tested with VB 3 and VB 4-16, if you convert
'this for use with other versions please let me know.-Burt Abreu
'-------------------------------------------------------------------
' Here's how to play an .AVI file via API
' Declare this API:
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal pstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal CallBack%)
'Add this code to the appropriate event:
Dim CmdStr$
Dim ReturnVal&
' Modify path and filename as necessary
CmdStr$ = "play G:\VFW_CINE\AK1.AVI"
ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&)
' To play the AVI 'fullscreen' append to CmdStr$:
CmdStr$ = "play G:\VFW_CINE\AK1.AVI fullscreen"
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'web : www.cadvision.com
'Posted:11/01/97
'
How to extract sounds from the SOUND.DRV library..
'Note: This has only been tested with VB 3 and VB 4-16, if you convert
'this for use with other versions please let me know.-Burt Abreu
'-------------------------------------------------------------------
' Here are 4 different sound effects that can called
' via API's to the "SOUND.DRV" library. You can modify
' the values to create your own unique sounds.
' Declare these API's:
Declare Function OpenSound% Lib "sound.drv" ()
Declare Function VoiceQueueSize% Lib "sound.drv" (ByVal nVoice%, ByVal nByteS)
Declare Function SetVoiceSound% Lib "sound.drv" (ByVal nSource%, ByVal Freq&,
ByVal nDuration%)
Declare Function StartSound% Lib "sound.drv" ()
Declare Function CloseSound% Lib "sound.drv" ()
Declare Function WaitSoundState% Lib "sound.drv" (ByVal State%)
' Add this routine, to be used with SirenSound1 routine
Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
Dim S As Integer
' Shift frequency to high byte.
Freq = Freq * 2 ^ 16
S = SetVoiceSound(1, Freq, Duration)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
End Sub
' Here are the 4 sound routines:
'* Attention Sound #1 *
Sub AttenSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 1500 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1500 * 2 ^ 16, 100)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 100)
S = SetVoiceSound(1, 800 * 2 ^ 16, 40)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
'* Click Sound #1 *
Sub ClickSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 200 * 2 ^ 16, 2)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
'* Error Sound #1 *
Sub ErrorSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 200 * 2 ^ 16, 150)
S = SetVoiceSound(1, 100 * 2 ^ 16, 100)
S = SetVoiceSound(1, 80 * 2 ^ 16, 90)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
'* SirenSound #1 *
Sub SirenSound1 ()
Dim Succ As Integer
Dim J As Long
Succ = OpenSound()
For J = 440 To 1000 Step 5
Call Sound(J, J / 100)
Next J
For J = 1000 To 440 Step -5
Call Sound(J, J / 100)
Next J
Succ = CloseSound()
End Sub
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'web : www.cadvision.com
'Posted:11/01/97
'
'How to play a CD Audio disc using API and the MMSYSTEM.DLL.
'Note: This has only been tested with VB 3 and VB 4-16, if you convert
'this for use with other versions please let me know.-Burt Abreu
'-------------------------------------------------------------------
' How to play a CD Audio disc via API
' Declare the following API
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal lpstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal hCallBack%)
'Add the code below to appropriate routines
Sub cmdPlay_Click ()
Dim lRet As Long
Dim nCurrentTrack As Integer
'Open the device
lRet = mciSendString("open cdaudio alias cd wait", 0&, 0, 0)
'Set the time format to Tracks (default is milliseconds)
lRet = mciSendString("set cd time format tmsf", 0&, 0, 0)
'Then to play from the beginning
lRet = mciSendString("play cd", 0&, 0, 0)
'Or to play from a specific track, say track 4
nCurrentTrack = 4
lRet = mciSendString("play cd from" & Str(nCurrentTrack), 0&, 0, 0)
End Sub
' Remember to Close the device when ending playback
Sub cmdStop_Click ()
Dim lRet As Long
'Stop the playback
lRet = mciSendString("stop cd wait", 0&, 0, 0)
DoEvents 'Let Windows process the event
'Close the device
lRet = mciSendString("close cd", 0&, 0, 0)
End Sub
