50(1).txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

如何从"SOUND.DRV"中提取声音   
          
'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'How to extract sounds from the SOUND.DRV library..
' 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