home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_tips
/
vb_tips
/
soundfx.ba_
/
soundfx.ba
Wrap
Text File
|
1994-04-29
|
6KB
|
132 lines
Option Explicit
'****************************************************
'* SOUNDFX.BAS Version 1.0 Date: 3/30/94 *
'* DPM Computer Solutions *
'* 8430-D Summerdale Road San Diego CA 92126-5415 *
'* InterNet: DPMCS@HIGH-COUNTRY.COM *
'* Compuserve: 74227,1557 *
'****************************************************
Declare Function OpenSound Lib "sound.drv" () As Integer
Declare Function VoiceQueueSize Lib "sound.drv" (ByVal nVoice%, ByVal nByteS) As Integer
Declare Function SetVoiceSound Lib "sound.drv" (ByVal nSource%, ByVal Freq&, ByVal nDuration%) As Integer
Declare Function StartSound Lib "sound.drv" () As Integer
Declare Function CloseSound Lib "sound.drv" () As Integer
Declare Function WaitSoundState Lib "sound.drv" (ByVal State%) As Integer
'*******************************************************
'* Procedure Name: AttenSound1 *
'*-----------------------------------------------------*
'* Created: 2/2/94 By: David McCarter *
'* Modified: By: *
'*=====================================================*
'* 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, 800 * 2 ^ 16, 40)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
'*******************************************************
'* Procedure Name: ClickSound1 *
'*-----------------------------------------------------*
'* Created: 2/2/94 By: David McCarter *
'* Modified: By: *
'*=====================================================*
'* 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 ' Wait for sound to play.
Succ = CloseSound()
End Sub
'*******************************************************
'* Procedure Name: ErrorSound1 *
'*-----------------------------------------------------*
'* Created: 2/2/94 By: David McCarter *
'* Modified: By: *
'*=====================================================*
'* 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 ' Wait for sound to play.
Succ = CloseSound()
End Sub
'*******************************************************
'* Procedure Name: SirenSound1 *
'*-----------------------------------------------------*
'* Created: 2/2/94 By: David McCarter *
'* Modified: By: *
'*=====================================================*
'* 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
'*******************************************************
'* Procedure Name: Sound *
'*-----------------------------------------------------*
'* Created: By: *
'* Modified: By: *
'*=====================================================*
'* Creates the sound. *
'* *
'* *
'* *
'* *
'*******************************************************
Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
Dim S As Integer
Freq = Freq * 2 ^ 16 ' Shift frequency to high byte.
S = SetVoiceSound(1, Freq, Duration)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
End Sub