Visual Basic Programming Code Examples

Visual Basic > Multimedia Animation and Sound Code Examples

How to extract sounds from the SOUND.DRV library.



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

' 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