home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / DICAS / VB_TIPS / SOUNDFX.BA_ / SOUNDFX.BA
Encoding:
Text File  |  1994-04-30  |  5.6 KB  |  132 lines
  1. Option Explicit
  2. '****************************************************
  3. '* SOUNDFX.BAS Version 1.0 Date: 3/30/94            *
  4. '* DPM Computer Solutions                           *
  5. '* 8430-D Summerdale Road San Diego CA 92126-5415   *
  6. '* InterNet: DPMCS@HIGH-COUNTRY.COM                 *
  7. '* Compuserve: 74227,1557                           *
  8. '****************************************************
  9. Declare Function OpenSound Lib "sound.drv" () As Integer
  10. Declare Function VoiceQueueSize Lib "sound.drv" (ByVal nVoice%, ByVal nByteS) As Integer
  11. Declare Function SetVoiceSound Lib "sound.drv" (ByVal nSource%, ByVal Freq&, ByVal nDuration%) As Integer
  12. Declare Function StartSound Lib "sound.drv" () As Integer
  13. Declare Function CloseSound Lib "sound.drv" () As Integer
  14. Declare Function WaitSoundState Lib "sound.drv" (ByVal State%) As Integer
  15.  
  16. '*******************************************************
  17. '* Procedure Name: AttenSound1                         *
  18. '*-----------------------------------------------------*
  19. '* Created: 2/2/94    By: David McCarter               *
  20. '* Modified:          By:                              *
  21. '*=====================================================*
  22. '* Attention Sound #1                                  *
  23. '*                                                     *
  24. '*                                                     *
  25. '*                                                     *
  26. '*                                                     *
  27. '*******************************************************
  28. Sub AttenSound1 ()
  29. Dim Succ, S As Integer
  30.    Succ = OpenSound()
  31.    S = SetVoiceSound(1, 1500 * 2 ^ 16, 50)
  32.    S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
  33.    S = SetVoiceSound(1, 800 * 2 ^ 16, 40)
  34.  
  35.    S = StartSound()
  36.    While (WaitSoundState(1) <> 0): Wend
  37.    Succ = CloseSound()
  38.  
  39. End Sub
  40.  
  41. '*******************************************************
  42. '* Procedure Name: ClickSound1                         *
  43. '*-----------------------------------------------------*
  44. '* Created: 2/2/94    By: David McCarter               *
  45. '* Modified:          By:                              *
  46. '*=====================================================*
  47. '* Click Sound #1                                      *
  48. '*                                                     *
  49. '*                                                     *
  50. '*                                                     *
  51. '*                                                     *
  52. '*******************************************************
  53. Sub ClickSound1 ()
  54. Dim Succ, S As Integer
  55.    Succ = OpenSound()
  56.    S = SetVoiceSound(1, 200 * 2 ^ 16, 2)
  57.    S = StartSound()
  58.    While (WaitSoundState(1) <> 0): Wend       ' Wait for sound to play.
  59.    Succ = CloseSound()
  60.  
  61. End Sub
  62.  
  63. '*******************************************************
  64. '* Procedure Name: ErrorSound1                         *
  65. '*-----------------------------------------------------*
  66. '* Created: 2/2/94    By: David McCarter               *
  67. '* Modified:          By:                              *
  68. '*=====================================================*
  69. '* Error Sound #1                                      *
  70. '*                                                     *
  71. '*                                                     *
  72. '*                                                     *
  73. '*                                                     *
  74. '*******************************************************
  75. Sub ErrorSound1 ()
  76. Dim Succ, S As Integer
  77.    Succ = OpenSound()
  78.    S = SetVoiceSound(1, 200 * 2 ^ 16, 150)
  79.    S = SetVoiceSound(1, 100 * 2 ^ 16, 100)
  80.    S = SetVoiceSound(1, 80 * 2 ^ 16, 90)
  81.    S = StartSound()
  82.    While (WaitSoundState(1) <> 0): Wend       ' Wait for sound to play.
  83.    Succ = CloseSound()
  84. End Sub
  85.  
  86. '*******************************************************
  87. '* Procedure Name: SirenSound1                         *
  88. '*-----------------------------------------------------*
  89. '* Created: 2/2/94    By: David McCarter               *
  90. '* Modified:          By:                              *
  91. '*=====================================================*
  92. '* SirenSound #1                                       *
  93. '*                                                     *
  94. '*                                                     *
  95. '*                                                     *
  96. '*                                                     *
  97. '*******************************************************
  98. Sub SirenSound1 ()
  99. Dim Succ As Integer
  100. Dim J As Long
  101.    Succ = OpenSound()
  102.    For J = 440 To 1000 Step 5
  103.       Call Sound(J, J / 100)
  104.    Next J
  105.    For J = 1000 To 440 Step -5
  106.       Call Sound(J, J / 100)
  107.    Next J
  108.    Succ = CloseSound()
  109.  
  110. End Sub
  111.  
  112. '*******************************************************
  113. '* Procedure Name: Sound                               *
  114. '*-----------------------------------------------------*
  115. '* Created:           By:                              *
  116. '* Modified:          By:                              *
  117. '*=====================================================*
  118. '* Creates the sound.                                  *
  119. '*                                                     *
  120. '*                                                     *
  121. '*                                                     *
  122. '*                                                     *
  123. '*******************************************************
  124. Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
  125. Dim S As Integer
  126.    Freq = Freq * 2 ^ 16                 ' Shift frequency to high byte.
  127.    S = SetVoiceSound(1, Freq, Duration)
  128.    S = StartSound()
  129.    While (WaitSoundState(1) <> 0): Wend
  130. End Sub
  131.  
  132.