How to play a WAV file with VB.
How to detect if a sound card exists on a system.
How to play an .AVI file using API and the MMSYSTEM.DLL.
How to extract sounds from the SOUND.DRV library.
How to play a CD Audio disc using API and the MMSYSTEM.DLL.
How to play a .WAV file using API and the MMSYSTEM.DLL.
Note: Some of these items are for 16-bit windows. 16-bit
systems used the MMSYSTEM.DLL for multimedia, 32-bit systems now
use WINMM.DLL.
'---------------------------------------------------------------- '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