home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Play_multi20264710232006.psc / SoundManager.bas < prev    next >
BASIC Source File  |  2006-10-22  |  21KB  |  512 lines
  1. Attribute VB_Name = "SoundManager"
  2. Option Explicit
  3.  
  4. ' **********************************************************
  5. ' * File Information                                       *
  6. ' * ================                                       *
  7. ' * File        : SoundManager,bas                         *
  8. ' * Author      : grigri <grigri@shinyhappypixels.com>     *
  9. ' * Description : How to play multiple sound files         *
  10. ' *               simultaneously in VB6.                   *
  11. ' * Version     : 1.0                                      *
  12. ' **********************************************************
  13. ' * Version History                                        *
  14. ' * ===============                                        *
  15. ' * 22/10/06   v1.0  Initial Version                       *
  16. ' **********************************************************
  17.  
  18. ' =========== API Declares (lots, I'm afraid) =============
  19.  
  20. Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
  21.  
  22.  
  23. Private Const WHDR_DONE As Long = &H1
  24. Private Const WHDR_PREPARED As Long = &H2
  25.  
  26. Private Const CALLBACK_WINDOW As Long = &H10000
  27.  
  28.  
  29. Private Const WAVE_MAPPED As Long = &H4
  30. Private Const WAVE_MAPPER As Long = -1&
  31.  
  32. Private Const MMSYSERR_BASE As Long = 0
  33. Private Const MMSYSERR_ALLOCATED As Long = (MMSYSERR_BASE + 4)
  34. Private Const MMSYSERR_BADDB As Long = (MMSYSERR_BASE + 14)
  35. Private Const MMSYSERR_BADDEVICEID As Long = (MMSYSERR_BASE + 2)
  36. Private Const MMSYSERR_BADERRNUM As Long = (MMSYSERR_BASE + 9)
  37. Private Const MMSYSERR_DELETEERROR As Long = (MMSYSERR_BASE + 18)
  38. Private Const MMSYSERR_ERROR As Long = (MMSYSERR_BASE + 1)
  39. Private Const MMSYSERR_HANDLEBUSY As Long = (MMSYSERR_BASE + 12)
  40. Private Const MMSYSERR_INVALFLAG As Long = (MMSYSERR_BASE + 10)
  41. Private Const MMSYSERR_INVALHANDLE As Long = (MMSYSERR_BASE + 5)
  42. Private Const MMSYSERR_INVALIDALIAS As Long = (MMSYSERR_BASE + 13)
  43. Private Const MMSYSERR_INVALPARAM As Long = (MMSYSERR_BASE + 11)
  44. Private Const MMSYSERR_KEYNOTFOUND As Long = (MMSYSERR_BASE + 15)
  45. Private Const MMSYSERR_LASTERROR As Long = (MMSYSERR_BASE + 13)
  46. Private Const MMSYSERR_MOREDATA As Long = (MMSYSERR_BASE + 21)
  47. Private Const MMSYSERR_NODRIVER As Long = (MMSYSERR_BASE + 6)
  48. Private Const MMSYSERR_NODRIVERCB As Long = (MMSYSERR_BASE + 20)
  49. Private Const MMSYSERR_NOERROR As Long = 0
  50. Private Const MMSYSERR_NOMEM As Long = (MMSYSERR_BASE + 7)
  51. Private Const MMSYSERR_NOTENABLED As Long = (MMSYSERR_BASE + 3)
  52. Private Const MMSYSERR_NOTSUPPORTED As Long = (MMSYSERR_BASE + 8)
  53. Private Const MMSYSERR_READERROR As Long = (MMSYSERR_BASE + 16)
  54. Private Const MMSYSERR_VALNOTFOUND As Long = (MMSYSERR_BASE + 19)
  55. Private Const MMSYSERR_WRITEERROR As Long = (MMSYSERR_BASE + 17)
  56.  
  57.  
  58.  
  59.  
  60. Private Type WAVEHDR
  61.     lpData As Long
  62.     dwBufferLength As Long
  63.     dwBytesRecorded As Long
  64.     dwUser As Long
  65.     dwFlags As Long
  66.     dwLoops As Long
  67.     lpNext As Long
  68.     Reserved As Long
  69. End Type
  70.  
  71. Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
  72. Private Declare Function waveOutOpen Lib "winmm.dll" (ByRef lphWaveOut As Long, ByVal uDeviceID As Long, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  73. Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  74. Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  75. Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  76. Private Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
  77. Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
  78. Private Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
  79.  
  80. '-------------
  81.  
  82. Private Const MMIO_ALLOCBUF As Long = &H10000
  83. Private Const MMIO_COMPAT As Long = &H0
  84. Private Const MMIO_CREATE As Long = &H1000
  85. Private Const MMIO_CREATELIST As Long = &H40
  86. Private Const MMIO_CREATERIFF As Long = &H20
  87. Private Const MMIO_DEFAULTBUFFER As Long = 8192
  88. Private Const MMIO_DELETE As Long = &H200
  89. Private Const MMIO_DENYNONE As Long = &H40
  90. Private Const MMIO_DENYREAD As Long = &H30
  91. Private Const MMIO_DENYWRITE As Long = &H20
  92. Private Const MMIO_DIRTY As Long = &H10000000
  93. Private Const MMIO_EMPTYBUF As Long = &H10
  94. Private Const MMIO_EXCLUSIVE As Long = &H10
  95. Private Const MMIO_EXIST As Long = &H4000
  96. Private Const MMIO_FHOPEN As Long = &H10
  97. Private Const MMIO_FINDCHUNK As Long = &H10
  98. Private Const MMIO_FINDLIST As Long = &H40
  99. Private Const MMIO_FINDPROC As Long = &H40000
  100. Private Const MMIO_FINDRIFF As Long = &H20
  101. Private Const MMIO_GETTEMP As Long = &H20000
  102. Private Const MMIO_GLOBALPROC As Long = &H10000000
  103. Private Const MMIO_INSTALLPROC As Long = &H10000
  104. Private Const MMIO_OPEN_VALID As Long = &H3FFFF
  105. Private Const MMIO_PARSE As Long = &H100
  106. Private Const MMIO_PUBLICPROC As Long = &H10000000
  107. Private Const MMIO_READ As Long = &H0
  108. Private Const MMIO_READWRITE As Long = &H2
  109. Private Const MMIO_REMOVEPROC As Long = &H20000
  110. Private Const MMIO_RWMODE As Long = &H3
  111. Private Const MMIO_SHAREMODE As Long = &H70
  112. Private Const MMIO_TOUPPER As Long = &H10
  113. Private Const MMIO_UNICODEPROC As Long = &H1000000
  114. Private Const MMIO_VALIDPROC As Long = &H11070000
  115. Private Const MMIO_WRITE As Long = &H1
  116. Private Const MMIOERR_BASE As Long = 256
  117. Private Const MMIOERR_ACCESSDENIED As Long = (MMIOERR_BASE + 12)
  118. Private Const MMIOERR_CANNOTCLOSE As Long = (MMIOERR_BASE + 4)
  119. Private Const MMIOERR_CANNOTEXPAND As Long = (MMIOERR_BASE + 8)
  120. Private Const MMIOERR_CANNOTOPEN As Long = (MMIOERR_BASE + 3)
  121. Private Const MMIOERR_CANNOTREAD As Long = (MMIOERR_BASE + 5)
  122. Private Const MMIOERR_CANNOTSEEK As Long = (MMIOERR_BASE + 7)
  123. Private Const MMIOERR_CANNOTWRITE As Long = (MMIOERR_BASE + 6)
  124. Private Const MMIOERR_CHUNKNOTFOUND As Long = (MMIOERR_BASE + 9)
  125. Private Const MMIOERR_FILENOTFOUND As Long = (MMIOERR_BASE + 1)
  126. Private Const MMIOERR_INVALIDFILE As Long = (MMIOERR_BASE + 16)
  127. Private Const MMIOERR_NETWORKERROR As Long = (MMIOERR_BASE + 14)
  128. Private Const MMIOERR_OUTOFMEMORY As Long = (MMIOERR_BASE + 2)
  129. Private Const MMIOERR_PATHNOTFOUND As Long = (MMIOERR_BASE + 11)
  130. Private Const MMIOERR_SHARINGVIOLATION As Long = (MMIOERR_BASE + 13)
  131. Private Const MMIOERR_TOOMANYOPENFILES As Long = (MMIOERR_BASE + 15)
  132. Private Const MMIOERR_UNBUFFERED As Long = (MMIOERR_BASE + 10)
  133. Private Const MMIOM_CLOSE As Long = 4
  134. Private Const MMIOM_OPEN As Long = 3
  135. Private Const MMIOM_READ As Long = MMIO_READ
  136. Private Const MMIOM_RENAME As Long = 6
  137. Private Const MMIOM_SEEK As Long = 2
  138. Private Const MMIOM_USER As Long = &H8000
  139. Private Const MMIOM_WRITE As Long = MMIO_WRITE
  140. Private Const MMIOM_WRITEFLUSH As Long = 5
  141.  
  142. Private Type MMCKINFO
  143.     ckid As Long
  144.     ckSize As Long
  145.     fccType As Long
  146.     dwDataOffset As Long
  147.     dwFlags As Long
  148. End Type
  149.  
  150. Private Type MMIOINFO
  151.     dwFlags As Long
  152.     fccIOProc As Long
  153.     pIOProc As Long
  154.     wErrorRet As Long
  155.     htask As Long
  156.     cchBuffer As Long
  157.     pchBuffer As String
  158.     pchNext As String
  159.     pchEndRead As String
  160.     pchEndWrite As String
  161.     lBufOffset As Long
  162.     lDiskOffset As Long
  163.     adwInfo(4) As Long
  164.     dwReserved1 As Long
  165.     dwReserved2 As Long
  166.     hmmio As Long
  167. End Type
  168.  
  169. Private Declare Function mmioAdvance Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpmmioinfo As MMIOINFO, ByVal uFlags As Long) As Long
  170. Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpck As MMCKINFO, ByVal uFlags As Long) As Long
  171. Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
  172. Private Declare Function mmioCreateChunk Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpck As MMCKINFO, ByVal uFlags As Long) As Long
  173. Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpck As MMCKINFO, ByRef lpckParent As Any, ByVal uFlags As Long) As Long
  174. Private Declare Function mmioFlush Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
  175. Private Declare Function mmioGetInfo Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpmmioinfo As MMIOINFO, ByVal uFlags As Long) As Long
  176. Private Declare Function mmioInstallIOProc Lib "winmm.dll" Alias "mmioInstallIOProcA" (ByVal fccIOProc As Long, ByVal pIOProc As Long, ByVal dwFlags As Long) As Long
  177. Private Declare Function mmioInstallIOProcA Lib "winmm.dll" (ByVal fccIOProc As String, ByVal pIOProc As Long, ByVal dwFlags As Long) As Long
  178. Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, ByRef lpmmioinfo As Any, ByVal dwOpenFlags As Long) As Long
  179. Private Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, ByRef pch As Any, ByVal cch As Long) As Long
  180. Private Declare Function mmioRename Lib "winmm.dll" Alias "mmioRenameA" (ByVal szFileName As String, ByVal SzNewFileName As String, ByRef lpmmioinfo As MMIOINFO, ByVal dwRenameFlags As Long) As Long
  181. Private Declare Function mmioSeek Lib "winmm.dll" (ByVal hmmio As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
  182. Private Declare Function mmioSendMessage Lib "winmm.dll" (ByVal hmmio As Long, ByVal uMsg As Long, ByVal lParam1 As Long, ByVal lParam2 As Long) As Long
  183. Private Declare Function mmioSetBuffer Lib "winmm.dll" (ByVal hmmio As Long, ByVal pchBuffer As String, ByVal cchBuffer As Long, ByVal uFlags As Long) As Long
  184. Private Declare Function mmioSetInfo Lib "winmm.dll" (ByVal hmmio As Long, ByRef lpmmioinfo As MMIOINFO, ByVal uFlags As Long) As Long
  185. Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
  186. Private Declare Function mmioWrite Lib "winmm.dll" (ByVal hmmio As Long, ByVal pch As String, ByVal cch As Long) As Long
  187. Private Declare Function mmsystemGetVersion Lib "winmm.dll" () As Long
  188.  
  189. Private Type WAVEFORMATEX
  190.     wFormatTag As Integer
  191.     nChannels As Integer
  192.     nSamplesPerSec As Long
  193.     nAvgBytesPerSec As Long
  194.     nBlockAlign As Integer
  195.     wBitsPerSample As Integer
  196.     cbSize As Integer
  197. End Type
  198.  
  199. Private Const SEEK_SET As Long = 0
  200.  
  201. '------------ Window Handling Declarations (needed for the callback window)
  202. Private Const MM_WOM_CLOSE As Long = &H3BC
  203. Private Const MM_WOM_DONE As Long = &H3BD
  204. Private Const MM_WOM_OPEN As Long = &H3BB
  205. Private Const WM_DESTROY As Long = &H2
  206. Private Const WM_CLOSE As Long = &H10
  207.  
  208.  
  209. Private Const SS_SIMPLE As Long = &HB&
  210. Private Const WS_POPUP As Long = &H80000000
  211.  
  212. Private Const GWL_WNDPROC As Long = -4
  213.  
  214.  
  215. Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  216. Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
  217. Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
  218. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  219.  
  220. ' ============ Non-API Declares; Internal Values ============
  221.  
  222. Private Const MAX_BUFFER_COUNT As Long = 32
  223.  
  224. Public Enum SoundBufferFlags
  225.     BufferFlagNone = 0
  226.     BufferFlagAutoPlay = 1
  227.     BufferFlagFreeWhenDone = 2
  228.     BufferFlagNoNotify = 4
  229.     ' This one's just for convenience
  230.     BufferFlagInstant = BufferFlagAutoPlay Or BufferFlagFreeWhenDone Or BufferFlagNoNotify
  231. End Enum
  232.  
  233. Public Enum SoundBufferStatus
  234.     BufferError = -1
  235.     BufferEmpty = 0
  236.     BufferLoaded = 1
  237.     BufferPlaying = 2
  238. End Enum
  239.  
  240. Private Type SoundBufferInfo
  241.     hWaveOut As Long
  242.     hdr As WAVEHDR
  243.     buf() As Byte
  244.     status As SoundBufferStatus
  245.     flags As SoundBufferFlags
  246. End Type
  247.  
  248. Public Const ALL_SOUND_BUFFERS As Long = -1
  249.  
  250. Private Buffers(1 To MAX_BUFFER_COUNT) As SoundBufferInfo
  251.  
  252. Private hCallbackWnd As Long
  253. Private pfnOldWindowProc As Long
  254.  
  255. Public Notifier As SoundManagerNotifier
  256.  
  257. Public Sub DestroySoundManager()
  258.     ' Do not forget to call this when you're done.
  259.     FreeSound ALL_SOUND_BUFFERS
  260.     If hCallbackWnd <> 0 Then
  261.         SetWindowLong hCallbackWnd, GWL_WNDPROC, pfnOldWindowProc
  262.         DestroyWindow hCallbackWnd
  263.     End If
  264. End Sub
  265.  
  266. Private Function FindIndexFromHandle(ByVal hWaveOut As Long) As Long
  267.     ' This should be optimized into a fast lookup routine, but
  268.     ' for the small amount of buffers here it doesn't matter.
  269.     ' (returns 0 if not found)
  270.     Dim BufferIndex As Long
  271.     For BufferIndex = 1 To MAX_BUFFER_COUNT
  272.         If Buffers(BufferIndex).hWaveOut = hWaveOut Then
  273.             FindIndexFromHandle = BufferIndex
  274.             Exit Function
  275.         End If
  276.     Next
  277. End Function
  278.  
  279. Public Function FreeBuffer() As Long
  280.     ' Find the first free buffer (returns 0 if none found)
  281.     Dim Index As Long
  282.     For Index = 1 To MAX_BUFFER_COUNT
  283.         If Buffers(Index).status = BufferEmpty Then
  284.             FreeBuffer = Index
  285.             Exit Function
  286.         End If
  287.     Next
  288. End Function
  289.  
  290. Public Function SoundStatus(ByVal BufferIndex As Long) As SoundBufferStatus
  291.     If BufferIndex < 1 Or BufferIndex > MAX_BUFFER_COUNT Then
  292.         SoundStatus = BufferError
  293.         Exit Function
  294.     End If
  295.     SoundStatus = Buffers(BufferIndex).status
  296. End Function
  297.  
  298. Public Function LoadSoundFile(ByVal BufferIndex As Long, ByVal FileName As String, Optional flags As SoundBufferFlags = BufferFlagNone) As Boolean
  299.     If BufferIndex < 1 Or BufferIndex > MAX_BUFFER_COUNT Then Exit Function
  300.     
  301.     ' Free any sound currently in the buffer
  302.     FreeSound BufferIndex
  303.  
  304.     Dim InputHandle As Long
  305.     Dim DataChunk As MMCKINFO
  306.     Dim ParentChunk As MMCKINFO
  307.     Dim InputChunk As MMCKINFO
  308.     Dim EmptyChunk As MMCKINFO
  309.     Dim MinSize As Long
  310.     Dim WaveFCC As Long
  311.     Dim RiffFCC As Long
  312.     Dim WaveFormat As WAVEFORMATEX
  313.     
  314.     MinSize = Len(WaveFormat) - 2
  315.     
  316.     WaveFCC = mmioStringToFOURCC("WAVE", 0)
  317.     RiffFCC = mmioStringToFOURCC("RIFF", 0)
  318.     
  319.     InputHandle = mmioOpen(FileName, ByVal 0&, MMIO_ALLOCBUF Or MMIO_READ)
  320.     If InputHandle = 0 Then
  321.         MsgBox "Cannot open file"
  322.         InputHandle = 0
  323.         Exit Function
  324.     End If
  325.     
  326.     If mmioDescend(InputHandle, ParentChunk, ByVal 0&, 0) <> 0 Then
  327.         MsgBox "Cannot descend"
  328.         GoTo CLEARUP_AND_EXIT
  329.     End If
  330.     
  331.     If ParentChunk.ckid <> RiffFCC Or ParentChunk.fccType <> WaveFCC Then
  332.         MsgBox "Incorrect format"
  333.         GoTo CLEARUP_AND_EXIT
  334.     End If
  335.     
  336.     InputChunk.ckid = mmioStringToFOURCC("fmt", 0)
  337.     
  338.     If mmioDescend(InputHandle, InputChunk, ParentChunk, MMIO_FINDCHUNK) <> 0 Then
  339.         MsgBox "Could not find fmt chunk"
  340.         GoTo CLEARUP_AND_EXIT
  341.     End If
  342.     
  343.     If InputChunk.ckSize < MinSize Then
  344.         MsgBox "Not enough data, only " & InputChunk.ckSize & ", wanted " & MinSize
  345.         GoTo CLEARUP_AND_EXIT
  346.     End If
  347.     
  348.     If mmioRead(InputHandle, WaveFormat, LenB(WaveFormat)) < MinSize Then
  349.         MsgBox "Not enough data read"
  350.         GoTo CLEARUP_AND_EXIT
  351.     End If
  352.     
  353.     If mmioSeek(InputHandle, ParentChunk.dwDataOffset + 4&, SEEK_SET) = -1 Then
  354.         MsgBox "Could not seek"
  355.         GoTo CLEARUP_AND_EXIT
  356.     End If
  357.     
  358.     DataChunk = EmptyChunk
  359.     
  360.     DataChunk.ckid = mmioStringToFOURCC("data", 0)
  361.     
  362.     If mmioDescend(InputHandle, DataChunk, ParentChunk, MMIO_FINDCHUNK) <> 0 Then
  363.         MsgBox "Could not descend into data"
  364.         GoTo CLEARUP_AND_EXIT
  365.     End If
  366.     
  367.     ' Make sure we have a callback window
  368.     If hCallbackWnd = 0 Then
  369.         If CreateCallbackWindow = False Then GoTo CLEARUP_AND_EXIT
  370.     End If
  371.  
  372.     
  373.     With Buffers(BufferIndex)
  374.         ReDim .buf(0 To DataChunk.ckSize - 1)
  375.         
  376.         If mmioRead(InputHandle, .buf(0), DataChunk.ckSize) <> DataChunk.ckSize Then
  377.             MsgBox "Could not read full buffer"
  378.             GoTo CLEARUP_AND_EXIT
  379.         End If
  380.         
  381.         Call waveOutOpen(.hWaveOut, WAVE_MAPPER, WaveFormat, hCallbackWnd, 0, CALLBACK_WINDOW)
  382.         ' Prep the header
  383.         .hdr.lpData = VarPtr(.buf(0))
  384.         .hdr.dwBufferLength = UBound(.buf) - LBound(.buf) + 1
  385.         
  386.         Call waveOutPrepareHeader(.hWaveOut, .hdr, LenB(.hdr))
  387.         
  388.         .status = BufferLoaded
  389.         .flags = flags
  390.         
  391.         LoadSoundFile = True
  392.         
  393.         ' Send notification if needed
  394.         If Not (Notifier Is Nothing) And Not (CBool(.flags And BufferFlagNoNotify)) Then Call Notifier.SoundLoaded(BufferIndex)
  395.         
  396.         ' Check for automatic playback
  397.         If flags And BufferFlagAutoPlay Then
  398.             PlaySound BufferIndex
  399.         End If
  400.     End With
  401.     
  402. CLEARUP_AND_EXIT:
  403.     If InputHandle <> 0 Then
  404.         Call mmioClose(InputHandle, 0)
  405.         InputHandle = 0
  406.     End If
  407. End Function
  408.  
  409. Public Sub FreeSound(ByVal BufferIndex As Long)
  410.     ' Handle the "all buffers" flag
  411.     If BufferIndex = ALL_SOUND_BUFFERS Then
  412.         For BufferIndex = 1 To MAX_BUFFER_COUNT
  413.             If Buffers(BufferIndex).status <> BufferEmpty Then FreeSound BufferIndex
  414.         Next
  415.         Exit Sub
  416.     End If
  417.     
  418.     If Buffers(BufferIndex).status = BufferEmpty Then Exit Sub
  419.     
  420.     ' If the sound is currently playing then we need to stop it first
  421.     StopSound BufferIndex
  422.     
  423.     With Buffers(BufferIndex)
  424.         ' Unprepare the header
  425.         waveOutUnprepareHeader .hWaveOut, .hdr, LenB(.hdr)
  426.         ' Close the handle
  427.         Call waveOutClose(.hWaveOut)
  428.         .hWaveOut = 0
  429.         ' Erase the buffer
  430.         Erase .buf
  431.         ZeroMemory .hdr, LenB(.hdr)
  432.         ' Set the status to empty
  433.         .status = BufferEmpty
  434.         
  435.         Debug.Print "Sound " & BufferIndex & " Freed"
  436.         If Not (Notifier Is Nothing) And Not (CBool(.flags And BufferFlagNoNotify)) Then Call Notifier.SoundUnloaded(BufferIndex)
  437.     End With
  438. End Sub
  439.  
  440. Public Sub StopSound(ByVal BufferIndex As Long)
  441.     ' Handle the "all buffers" flag
  442.     If BufferIndex = ALL_SOUND_BUFFERS Then
  443.         For BufferIndex = 1 To MAX_BUFFER_COUNT
  444.             StopSound BufferIndex
  445.         Next
  446.         Exit Sub
  447.     End If
  448.     
  449.     With Buffers(BufferIndex)
  450.         Debug.Print .status
  451.         If .status = BufferPlaying Then waveOutReset .hWaveOut
  452.     End With
  453. End Sub
  454.  
  455. Public Function PlaySound(ByVal BufferIndex As Long) As Boolean
  456.     ' Check we've got a valid index
  457.     If BufferIndex < 1 Or BufferIndex > MAX_BUFFER_COUNT Then Exit Function
  458.         
  459.     StopSound BufferIndex
  460.     With Buffers(BufferIndex)
  461.         ' The sound must be loaded and not currently playing to be played
  462.         If .status <> BufferLoaded Then Exit Function
  463.         
  464.         ' Ensure we have a valid handle loaded
  465.         If .hWaveOut = 0 Then Exit Function
  466.         
  467.         ' Write the data to the sound device
  468.         Call waveOutWrite(.hWaveOut, .hdr, LenB(.hdr))
  469.         
  470.         ' Update status
  471.         .status = BufferPlaying
  472.     
  473.         ' Notify if required
  474.         If Not (Notifier Is Nothing) And Not (CBool(.flags And BufferFlagNoNotify)) Then Call Notifier.SoundPlayStart(BufferIndex)
  475.     End With
  476.     
  477.     ' All done!
  478.     PlaySound = True
  479. End Function
  480.  
  481. Private Function CreateCallbackWindow() As Boolean
  482.     If hCallbackWnd <> 0 Then Exit Function
  483.     hCallbackWnd = CreateWindowEx(0, "STATIC", "Soundmanager Window", WS_POPUP Or SS_SIMPLE, 0, 0, 100, 20, 0, 0, App.hInstance, ByVal 0&)
  484.     If hCallbackWnd = 0 Then Exit Function
  485.     pfnOldWindowProc = SetWindowLong(hCallbackWnd, GWL_WNDPROC, AddressOf CallbackWindowProc)
  486.     
  487.     CreateCallbackWindow = True
  488. End Function
  489.  
  490. Private Function CallbackWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  491.     Dim BufferIndex As Long
  492.     
  493.     Select Case uMsg
  494. '    Case MM_WOM_OPEN
  495. '    Case MM_WOM_CLOSE
  496.     Case MM_WOM_DONE
  497.         BufferIndex = FindIndexFromHandle(wParam)
  498.         If BufferIndex <> 0 Then
  499.             With Buffers(BufferIndex)
  500.                 If Not (Notifier Is Nothing) And Not (CBool(.flags And BufferFlagNoNotify)) Then Call Notifier.SoundPlayEnd(BufferIndex)
  501.                 .status = BufferLoaded
  502.                 
  503.                 ' Automatic Free?
  504.                 If .flags And BufferFlagFreeWhenDone Then
  505.                     FreeSound BufferIndex
  506.                 End If
  507.             End With
  508.         End If
  509.     End Select
  510.     CallbackWindowProc = CallWindowProc(pfnOldWindowProc, hWnd, uMsg, wParam, lParam)
  511. End Function
  512.