home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / WaveOut_St20274210282006.psc / clsWaveOut.cls < prev   
Text File  |  2006-10-28  |  33KB  |  1,000 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "WaveOut"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. '**************************************'
  17. ' clsWaveOut                           '
  18. '                                      '
  19. ' play PCM data with the WaveOut API   '
  20. '**************************************'
  21.  
  22.  
  23. ' Buffer in memory:
  24. '
  25. '          Pointer
  26. '          ^
  27. ' +--------+------------+---------...
  28. ' |  hMem  |   WAVEHDR  | PCM
  29. ' +--------+------------+---------...
  30. '  4 Bytes    32 Bytes    x Bytes
  31.  
  32.  
  33. Private Const WAVE_FORMAT_PCM   As Long = 1
  34.  
  35. Private Const MMSYSERR_BASE     As Long = 0
  36. Private Const WAVERR_BASE       As Long = 32
  37.  
  38. Private Const MAXPNAMELEN       As Long = 32
  39. Private Const MAXERRORLENGTH    As Long = 256
  40.  
  41.  
  42. Private Type WAVEHDR
  43.     lpData              As Long
  44.     dwBufferLength      As Long
  45.     dwBytesRecorded     As Long
  46.     dwUser              As Long
  47.     dwFlags             As Long
  48.     dwLoops             As Long
  49.     lpNext              As Long
  50.     Reserved            As Long
  51. End Type
  52.  
  53. Private Type WAVEOUTCAPS
  54.     wMid                As Integer
  55.     wPid                As Integer
  56.     vDriverVersion      As Long
  57.     szPname(MAXPNAMELEN - 1) As Byte
  58.     dwFormats           As Long
  59.     wChannels           As Integer
  60.     dwSupport           As Long
  61. End Type
  62.  
  63. Private Type MMTIME
  64.     wType               As Long
  65.     u                   As Long
  66.     x                   As Long
  67. End Type
  68.  
  69. Private Type WAVEFORMATEX
  70.     wFormatTag          As Integer
  71.     nChannels           As Integer
  72.     nSamplesPerSec      As Long
  73.     nAvgBytesPerSec     As Long
  74.     nBlockAlign         As Integer
  75.     wBitsPerSample      As Integer
  76.     cbSize              As Integer
  77. End Type
  78.  
  79. Private Enum TIME_FORMAT
  80.     TIME_MS = &H1
  81.     TIME_SAMPLES = &H2
  82.     TIME_BYTES = &H4
  83.     TIME_SMPTE = &H8
  84.     TIME_MIDI = &H10
  85.     TIME_MIDI_TICKS = &H20
  86. End Enum
  87.  
  88. Private Enum WAVEFORM_STATUS
  89.     MM_WOM_OPEN = &H3BB
  90.     MM_WOM_CLOSE = &H3BC
  91.     MM_WOM_DONE = &H3BD
  92. End Enum
  93.  
  94. Private Enum MMSYS_ERROR
  95.     MMSYSERR_NOERROR = 0                         ' no error */
  96.     MMSYSERR_ERROR = (MMSYSERR_BASE + 1)         ' unspecified error */
  97.     MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)   ' device ID out of range */
  98.     MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)    ' driver failed enable */
  99.     MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)     ' device already allocated */
  100.     MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)   ' device handle is invalid */
  101.     MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)      ' no device driver present */
  102.     MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)         ' memory allocation error */
  103.     MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8)  ' function isn't supported */
  104.     MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)     ' error value out of range */
  105.     MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)    ' invalid flag passed */
  106.     MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)   ' invalid parameter passed */
  107.     MMSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12)   ' handle being used */
  108.                                                  ' simultaneously on another */
  109.                                                  ' thread (eg callback) */
  110.     MMSYSERR_INVALIDALIAS = (MMSYSERR_BASE + 13) ' specified alias not found */
  111.     MMSYSERR_BADDB = (MMSYSERR_BASE + 14)        ' bad registry database */
  112.     MMSYSERR_KEYNOTFOUND = (MMSYSERR_BASE + 15)  ' registry key not found */
  113.     MMSYSERR_READERROR = (MMSYSERR_BASE + 16)    ' registry read error */
  114.     MMSYSERR_WRITEERROR = (MMSYSERR_BASE + 17)   ' registry write error */
  115.     MMSYSERR_DELETEERROR = (MMSYSERR_BASE + 18)  ' registry delete error */
  116.     MMSYSERR_VALNOTFOUND = (MMSYSERR_BASE + 19)  ' registry value not found */
  117.     MMSYSERR_NODRIVERCB = (MMSYSERR_BASE + 20)   ' driver does not call DriverCallback */
  118.     MMSYSERR_LASTERROR = (MMSYSERR_BASE + 20)    ' last error in range */
  119. End Enum
  120.  
  121. Private Enum MMSYS_CALLBACK
  122.     CALLBACK_TYPEMASK = &H70000
  123.     CALLBACK_NULL = &H0
  124.     CALLBACK_WINDOW = &H10000
  125.     CALLBACK_TASK = &H20000
  126.     CALLBACK_FUNCTION = &H30000
  127.     CALLBACK_THREAD = (CALLBACK_TASK)
  128.     CALLBACK_EVENT = &H50000
  129. End Enum
  130.  
  131. Private Enum WAVE_ERR
  132.     WAVERR_BADFORMAT = (WAVERR_BASE + 0)    ' unsupported wave format */
  133.     WAVERR_STILLPLAYING = (WAVERR_BASE + 1) ' still something playing */
  134.     WAVERR_UNPREPARED = (WAVERR_BASE + 2)   ' header not prepared */
  135.     WAVERR_SYNC = (WAVERR_BASE + 3)         ' device is synchronous */
  136.     WAVERR_LASTERROR = (WAVERR_BASE + 3)    ' last error in range */
  137. End Enum
  138.  
  139. Private Enum WAVEOUT_FLAGS
  140.      WAVE_FORMAT_QUERY = &H1
  141.      WAVE_ALLOWSYNC = &H2
  142.      WAVE_MAPPED = &H4
  143.      WAVE_FORMAT_DIRECT = &H8
  144.      WAVE_FORMAT_DIRECT_QUERY = (WAVE_FORMAT_QUERY Or WAVE_FORMAT_DIRECT)
  145. End Enum
  146.  
  147. Private Enum WHDR_FLAGS
  148.     WHDR_DONE = &H1
  149.     WHDR_PREPARED = &H2
  150.     WHDR_BEGINLOOP = &H4
  151.     WHDR_ENDLOOP = &H8
  152.     WHDR_INQUEUE = &H10
  153. End Enum
  154.  
  155. Private Enum WAVECAPS_FLAGS
  156.     WAVECAPS_PITCH = &H1
  157.     WAVECAPS_PLAYBACKRATE = &H2
  158.     WAVECAPS_VOLUME = &H4
  159.     WAVECAPS_LRVOLUME = &H8
  160.     WAVECAPS_SYNC = &H10
  161.     WAVECAPS_SAMPLEACCURATE = &H20
  162.     WAVECAPS_DIRECTSOUND = &H40
  163. End Enum
  164.  
  165. Public Enum WO_STATUS
  166.     WO_PLAYING = 0
  167.     WO_PAUSING
  168.     WO_STOPPED
  169. End Enum
  170.  
  171. Private Enum MEM_ALLOC_FLAGS
  172.     GHND = &H40
  173.     GMEM_DDESHARE = &H2000
  174.     GMEM_DISCARDABLE = &H100
  175.     GMEM_FIXED = &H0
  176.     GMEM_MOVEABLE = &H2
  177.     GMEM_NOCOMPACT = &H10
  178.     GMEM_NODISCARD = &H20
  179.     GMEM_ZEROINIT = &H40
  180.     GPTR = &H42
  181. End Enum
  182.  
  183. '-Selfsub declarations----------------------------------------------------------------------------
  184. Private Enum eMsgWhen                                                       'When to callback
  185.   MSG_BEFORE = 1                                                            'Callback before the original WndProc
  186.   MSG_AFTER = 2                                                             'Callback after the original WndProc
  187.   MSG_BEFORE_AFTER = MSG_BEFORE Or MSG_AFTER                                'Callback before and after the original WndProc
  188. End Enum
  189.  
  190. Private Const ALL_MESSAGES  As Long = -1                                    'All messages callback
  191. Private Const MSG_ENTRIES   As Long = 32                                    'Number of msg table entries
  192. Private Const WNDPROC_OFF   As Long = &H38                                  'Thunk offset to the WndProc execution address
  193. Private Const GWL_WNDPROC   As Long = -4                                    'SetWindowsLong WndProc index
  194. Private Const IDX_SHUTDOWN  As Long = 1                                     'Thunk data index of the shutdown flag
  195. Private Const IDX_HWND      As Long = 2                                     'Thunk data index of the subclassed hWnd
  196. Private Const IDX_WNDPROC   As Long = 9                                     'Thunk data index of the original WndProc
  197. Private Const IDX_BTABLE    As Long = 11                                    'Thunk data index of the Before table
  198. Private Const IDX_ATABLE    As Long = 12                                    'Thunk data index of the After table
  199. Private Const IDX_PARM_USER As Long = 13                                    'Thunk data index of the User-defined callback parameter data index
  200.  
  201. Private z_ScMem             As Long                                         'Thunk base address
  202. Private z_Sc(64)            As Long                                         'Thunk machine-code initialised here
  203. Private z_Funk              As Collection                                   'hWnd/thunk-address collection
  204.  
  205. Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  206. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  207. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  208. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  209. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  210. Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
  211. Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  212. Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  213. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  214. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  215. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  216. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  217.  
  218. Private Declare Function waveOutGetPosition Lib "winmm.dll" ( _
  219.     ByVal hWaveOut As Long, _
  220.     lpInfo As Any, _
  221.     ByVal uSize As Long _
  222. ) As Long
  223.  
  224. Private Declare Function waveOutOpen Lib "winmm.dll" ( _
  225.     hWaveOut As Long, _
  226.     ByVal uDeviceID As Long, _
  227.     format As Any, _
  228.     ByVal dwCallback As Long, _
  229.     ByVal dwInstance As Long, _
  230.     ByVal dwFlags As Long _
  231. ) As Long
  232.  
  233. Private Declare Function waveOutPrepareHeader Lib "winmm.dll" ( _
  234.     ByVal hWaveOut As Long, _
  235.     lpWaveInHdr As Any, _
  236.     ByVal uSize As Long _
  237. ) As Long
  238.  
  239. Private Declare Function waveOutReset Lib "winmm.dll" ( _
  240.     ByVal hWaveOut As Long _
  241. ) As Long
  242.  
  243. Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" ( _
  244.     ByVal hWaveOut As Long, _
  245.     lpWaveInHdr As Any, _
  246.     ByVal uSize As Long _
  247. ) As Long
  248.  
  249. Private Declare Function waveOutClose Lib "winmm.dll" ( _
  250.     ByVal hWaveOut As Long _
  251. ) As Long
  252.  
  253. Private Declare Function waveOutGetDevCaps Lib "winmm.dll" _
  254. Alias "waveOutGetDevCapsA" ( _
  255.     ByVal uDeviceID As Long, _
  256.     lpCaps As Any, _
  257.     ByVal uSize As Long _
  258. ) As Long
  259.  
  260. Private Declare Function waveOutGetNumDevs Lib "winmm.dll" ( _
  261. ) As Long
  262.  
  263. Private Declare Function waveOutGetErrorText Lib "winmm.dll" _
  264. Alias "waveInGetErrorTextA" ( _
  265.     ByVal err As Long, _
  266.     ByVal lpText As String, _
  267.     ByVal uSize As Long _
  268. ) As Long
  269.  
  270. Private Declare Function waveOutWrite Lib "winmm.dll" ( _
  271.     ByVal hWaveOut As Long, _
  272.     lpWaveOutHdr As Any, _
  273.     ByVal uSize As Long _
  274. ) As Long
  275.  
  276. Private Declare Function waveOutRestart Lib "winmm.dll" ( _
  277.     ByVal hWaveOut As Long _
  278. ) As Long
  279.  
  280. Private Declare Function waveOutPause Lib "winmm.dll" ( _
  281.     ByVal hWaveOut As Long _
  282. ) As Long
  283.  
  284. Private Declare Function waveOutGetID Lib "winmm.dll" ( _
  285.     ByVal hWaveOut As Long, _
  286.     ByRef puDeviceID As Long _
  287. ) As Long
  288.  
  289. Private Declare Function waveOutSetVolume Lib "winmm.dll" ( _
  290.     ByVal hWaveOut As Long, _
  291.     ByVal dwVolume As Long _
  292. ) As Long
  293.  
  294. Private Declare Function waveOutGetVolume Lib "winmm.dll" ( _
  295.     ByVal hWaveOut As Long, _
  296.     ByRef pdwVolume As Long _
  297. ) As Long
  298.  
  299. Private Declare Function GlobalAlloc Lib "kernel32" ( _
  300.     ByVal wFlags As Long, _
  301.     ByVal dwBytes As Long _
  302. ) As Long
  303.  
  304. Private Declare Function GlobalLock Lib "kernel32" ( _
  305.     ByVal hMem As Long _
  306. ) As Long
  307.  
  308. Private Declare Function GlobalFree Lib "kernel32" ( _
  309.     ByVal hMem As Long _
  310. ) As Long
  311.  
  312. Private Declare Function GlobalUnlock Lib "kernel32" ( _
  313.     ByVal hMem As Long _
  314. ) As Long
  315.  
  316. Private Declare Sub ZeroMem Lib "kernel32" _
  317. Alias "RtlZeroMemory" ( _
  318.     pDst As Any, _
  319.     ByVal dwLen As Long _
  320. )
  321.  
  322. Private Declare Sub CpyMem Lib "kernel32" _
  323. Alias "RtlMoveMemory" ( _
  324.     pDst As Any, _
  325.     pSrc As Any, _
  326.     ByVal cb As Long _
  327. )
  328.  
  329. Private Declare Function PostMessage Lib "user32" _
  330. Alias "PostMessageA" ( _
  331.     ByVal hwnd As Long, _
  332.     ByVal wMsg As Long, _
  333.     ByVal wParam As Long, _
  334.     lParam As Any _
  335. ) As Long
  336.  
  337. Private Declare Function CallWindowProc Lib "user32" _
  338. Alias "CallWindowProcA" ( _
  339.     ByVal lpPrevWndFunc As Long, _
  340.     ByVal hwnd As Long, _
  341.     ByVal Msg As Long, _
  342.     ByVal wParam As Long, _
  343.     ByVal lParam As Long _
  344. ) As Long
  345.  
  346. Private Declare Function SetWindowLong Lib "user32" _
  347. Alias "SetWindowLongA" ( _
  348.     ByVal hwnd As Long, _
  349.     ByVal nIndex As Long, _
  350.     ByVal dwNewLong As Long _
  351. ) As Long
  352.  
  353. Private Declare Function CreateWindowEx Lib "user32" _
  354. Alias "CreateWindowExA" ( _
  355.     ByVal dwExStyle As Long, _
  356.     ByVal lpClassName As String, _
  357.     ByVal lpWindowName As String, _
  358.     ByVal dwStyle As Long, _
  359.     ByVal x As Long, _
  360.     ByVal y As Long, _
  361.     ByVal nWidth As Long, _
  362.     ByVal nHeight As Long, _
  363.     ByVal hWndParent As Long, _
  364.     ByVal hMenu As Long, _
  365.     ByVal hInstance As Long, _
  366.     ByVal lpParam As Long _
  367. ) As Long
  368.  
  369. Private Declare Function DestroyWindow Lib "user32" ( _
  370.     ByVal hwnd As Long _
  371. ) As Long
  372.  
  373.  
  374. Public Event BufferDone(ByVal userdata As Long)
  375. Public Event StatusChanged(ByVal status As WO_STATUS)
  376.  
  377.  
  378. Private wfx_out     As WAVEFORMATEX
  379.  
  380. Private blnReady    As Boolean
  381. Private udeStatus   As WO_STATUS
  382.  
  383. Private hWO         As Long
  384. Private hFakeWnd    As Long
  385. Private pOldWndProc As Long
  386.  
  387. Private lngBufCnt   As Long
  388.  
  389. Private lngAddTime  As Long
  390.  
  391. ''''''''''''''''''''''''''''''''''''''''''''''
  392. ''''''''''''''''''''''''''''''''''''''''''''''
  393. ''''''''''''''''''''''''''''''''''''''''''''''
  394.  
  395. ' number of buffers in the WaveOut Buffer Queue
  396. Public Property Get Buffers( _
  397. ) As Long
  398.  
  399.     Buffers = lngBufCnt
  400. End Property
  401.  
  402. Public Property Get VolumeForDev( _
  403.     ByVal idx As Integer _
  404. ) As Long
  405.  
  406.     Dim lngVolume   As Long
  407.     
  408.     waveOutGetVolume idx, lngVolume
  409.     
  410.     VolumeForDev = (lngVolume And &HFFFF&)
  411. End Property
  412.  
  413. Public Property Let VolumeForDev( _
  414.     ByVal idx As Integer, _
  415.     ByVal value As Long _
  416. )
  417.  
  418.     Dim lngVol As Long
  419.  
  420.     value = (value And &HFFFF&)
  421.  
  422.     RtlMoveMemory VarPtr(lngVol) + 0, VarPtr(value), 2
  423.     RtlMoveMemory VarPtr(lngVol) + 2, VarPtr(value), 2
  424.  
  425.     waveOutSetVolume idx, lngVol
  426. End Property
  427.  
  428. Public Property Get Volume( _
  429. ) As Long
  430.  
  431.     Dim lngVolume   As Long
  432.  
  433.     waveOutGetVolume hWO, lngVolume
  434.  
  435.     ' one 16 bit word for one channel
  436.     Volume = (lngVolume And &HFFFF&)
  437. End Property
  438.  
  439. Public Property Let Volume( _
  440.     ByVal lngVolume As Long _
  441. )
  442.  
  443.     lngVolume = (lngVolume And &HFFFF&)
  444.  
  445.     RtlMoveMemory VarPtr(lngVolume) + 0, VarPtr(lngVolume), 2
  446.     RtlMoveMemory VarPtr(lngVolume) + 2, VarPtr(lngVolume), 2
  447.  
  448.     waveOutSetVolume hWO, lngVolume
  449. End Property
  450.  
  451. Public Property Get PlayStatus( _
  452. ) As WO_STATUS
  453.  
  454.     PlayStatus = udeStatus
  455. End Property
  456.  
  457. Public Function GetNumDevs( _
  458. ) As Long
  459.  
  460.     GetNumDevs = waveOutGetNumDevs()
  461. End Function
  462.  
  463. Public Function GetDevName( _
  464.     ByVal device_id As Long _
  465. ) As String
  466.  
  467.     Dim strDevName  As String
  468.     Dim lngNullChr  As Long
  469.     Dim udtCaps     As WAVEOUTCAPS
  470.  
  471.     waveOutGetDevCaps device_id, _
  472.                       udtCaps, _
  473.                       Len(udtCaps)
  474.  
  475.     strDevName = StrConv(udtCaps.szPname, vbUnicode)
  476.  
  477.     lngNullChr = InStr(strDevName, Chr$(0))
  478.     If lngNullChr < 1 Then lngNullChr = Len(strDevName)
  479.  
  480.     ' Device Name
  481.     strDevName = Left$(strDevName, lngNullChr - 1) & " "
  482.     ' Driver Version
  483.     strDevName = strDevName & ((udtCaps.vDriverVersion And &HFF00) \ &H100) & "."
  484.     strDevName = strDevName & ((udtCaps.vDriverVersion And &HFF) \ &H1)
  485.  
  486.     GetDevName = strDevName
  487. End Function
  488.  
  489. Public Function Init( _
  490.     ByVal samplerate As Long, _
  491.     ByVal Channels As Integer, _
  492.     ByVal BitsPerSample As Integer, _
  493.     Optional ByVal device_id As Long = -1 _
  494. ) As Boolean
  495.  
  496.     Dim udeErr  As MMSYS_ERROR
  497.  
  498.     ' just to be on the safe side
  499.     Deinit
  500.  
  501.     ' I don't think any other sample widths then 8/16/24
  502.     ' are allowed for PCM described with a WaveFormatEx structure.
  503.     If BitsPerSample < 8 Or BitsPerSample > 24 Then
  504.         Exit Function
  505.     End If
  506.  
  507.     If samplerate < 1 Or samplerate > 100000 Then
  508.         Exit Function
  509.     End If
  510.  
  511.     ' only support for mono/stereo
  512.     ' (are there more channels defined for WaveFormatEx?)
  513.     If Channels < 1 Or Channels > 2 Then
  514.         Exit Function
  515.     End If
  516.  
  517.     With wfx_out
  518.         .wFormatTag = WAVE_FORMAT_PCM
  519.         '
  520.         .wBitsPerSample = BitsPerSample
  521.         .nSamplesPerSec = samplerate
  522.         .nChannels = Channels
  523.         '
  524.         .nBlockAlign = .nChannels * (.wBitsPerSample / 8)
  525.         .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
  526.     End With
  527.  
  528.     lngAddTime = 0
  529.  
  530.     ' create an invisible window for WaveOut callbacks
  531.     hFakeWnd = CreateFakeWnd()
  532.     If hFakeWnd = 0 Then
  533.         blnReady = False
  534.         Exit Function
  535.     End If
  536.  
  537.     udeErr = waveOutOpen(hWO, _
  538.                          device_id, _
  539.                          wfx_out, _
  540.                          hFakeWnd, _
  541.                          0, _
  542.                          CALLBACK_WINDOW)
  543.  
  544.     If udeErr = MMSYSERR_NOERROR Then
  545.         HookFakeWindow
  546.  
  547.         waveOutPause hWO
  548.  
  549.         udeStatus = WO_STOPPED
  550.         RaiseEvent StatusChanged(udeStatus)
  551.  
  552.         blnReady = True
  553.         Init = True
  554.     Else
  555.         DestroyWindow hFakeWnd
  556.         hFakeWnd = 0
  557.         blnReady = False
  558.     End If
  559. End Function
  560.  
  561. Public Function Deinit( _
  562. ) As Boolean
  563.  
  564.     If Not blnReady Then Exit Function
  565.  
  566.     waveOutReset hWO
  567.     waveOutClose hWO
  568.     hWO = 0
  569.  
  570.     UnhookFakeWindow
  571.     DestroyWindow hFakeWnd
  572.     hFakeWnd = 0
  573.  
  574.     lngAddTime = 0
  575.  
  576.     blnReady = False
  577.  
  578.     udeStatus = WO_STOPPED
  579.     RaiseEvent StatusChanged(udeStatus)
  580.  
  581.     Deinit = True
  582. End Function
  583.  
  584. Public Function WriteSamples( _
  585.     ByVal buf_ptr As Long, _
  586.     ByVal buf_len As Long, _
  587.     Optional ByVal userdata As Long _
  588. ) As Boolean
  589.  
  590.     Dim pMem    As Long
  591.     Dim udeErr  As MMSYS_ERROR
  592.     Dim udtHdr  As WAVEHDR
  593.  
  594.     If Not blnReady Then Exit Function
  595.     If buf_len = 0 Then Exit Function
  596.  
  597.     ' data needs to be aligned on the block align
  598.     If buf_len Mod wfx_out.nBlockAlign Then Exit Function
  599.  
  600.     ' allocate some memory for WAVEHDR + PCM data
  601.     pMem = AllocBufferMem(buf_len + Len(udtHdr))
  602.     If pMem = 0 Then Exit Function
  603.  
  604.     With udtHdr
  605.         .dwUser = userdata
  606.         .dwBufferLength = buf_len
  607.         .lpData = pMem + Len(udtHdr)
  608.     End With
  609.  
  610.     ' copy WAVEHDR to the allocated buffer
  611.     CpyMem ByVal pMem, udtHdr, Len(udtHdr)
  612.  
  613.     ' copy PCM data to the buffer
  614.     CpyMem ByVal pMem + Len(udtHdr), _
  615.            ByVal buf_ptr, _
  616.            buf_len
  617.  
  618.     udeErr = waveOutPrepareHeader(hWO, _
  619.                                   ByVal pMem, _
  620.                                   Len(udtHdr))
  621.  
  622.     udeErr = waveOutWrite(hWO, _
  623.                           ByVal pMem, _
  624.                           Len(udtHdr))
  625.  
  626.     lngBufCnt = lngBufCnt + 1
  627.  
  628.     WriteSamples = True
  629. End Function
  630.  
  631. Public Function Pause( _
  632. ) As Boolean
  633.  
  634.     If Not blnReady Then Exit Function
  635.  
  636.     waveOutPause hWO
  637.     udeStatus = WO_PAUSING
  638.     RaiseEvent StatusChanged(udeStatus)
  639.  
  640.     Pause = True
  641. End Function
  642.  
  643. Public Function Play( _
  644. ) As Boolean
  645.  
  646.     If Not blnReady Then Exit Function
  647.  
  648.     waveOutRestart hWO
  649.     udeStatus = WO_PLAYING
  650.     RaiseEvent StatusChanged(udeStatus)
  651.  
  652.     Play = True
  653. End Function
  654.  
  655. Public Function StopPlayback( _
  656. ) As Boolean
  657.  
  658.     If Not blnReady Then Exit Function
  659.  
  660.     waveOutReset hWO
  661.     waveOutPause hWO
  662.  
  663.     lngAddTime = 0
  664.     lngBufCnt = 0
  665.     udeStatus = WO_STOPPED
  666.     RaiseEvent StatusChanged(udeStatus)
  667.  
  668.     StopPlayback = True
  669. End Function
  670.  
  671. Public Function ClearBufferQueue( _
  672. ) As Boolean
  673.  
  674.     waveOutReset hWO
  675.  
  676.     ClearBufferQueue = True
  677. End Function
  678.  
  679. Public Sub SetElapsed( _
  680.     ByVal lngMS As Long _
  681. )
  682.  
  683.     If Not blnReady Then Exit Sub
  684.  
  685.     lngAddTime = Elapsed() - (Elapsed() - lngMS)
  686. End Sub
  687.  
  688. Public Sub ResetElapsed( _
  689. )
  690.  
  691.     lngAddTime = -GetWaveOutElapsed
  692. End Sub
  693.  
  694. Private Function GetWaveOutElapsed() As Long
  695.     If Not blnReady Then Exit Function
  696.     
  697.     Dim udtTime As MMTIME
  698.     
  699.     ' the device mustn't support the selected
  700.     ' time format, in fact waveOutGetPosition can
  701.     ' return any time format
  702.     udtTime.wType = TIME_BYTES
  703.  
  704.     waveOutGetPosition hWO, udtTime, Len(udtTime)
  705.  
  706.     Select Case udtTime.wType
  707.         Case TIME_BYTES
  708.             GetWaveOutElapsed = (udtTime.u / wfx_out.nAvgBytesPerSec) * 1000
  709.         Case TIME_SAMPLES
  710.             GetWaveOutElapsed = (udtTime.u / wfx_out.nSamplesPerSec) * 1000
  711.         Case TIME_MS
  712.             GetWaveOutElapsed = udtTime.u
  713.     End Select
  714. End Function
  715.  
  716. Public Function Elapsed( _
  717. ) As Long
  718.  
  719.     If Not blnReady Then Exit Function
  720.  
  721.     Elapsed = GetWaveOutElapsed + lngAddTime
  722. End Function
  723.  
  724. ''''''''''''''''''''''''''''''''''''''''''''''
  725. ''''''''''''''''''''''''''''''''''''''''''''''
  726. ''''''''''''''''''''''''''''''''''''''''''''''
  727.  
  728. Private Function AllocBufferMem( _
  729.     ByVal bytes As Long _
  730. ) As Long
  731.  
  732.     Dim hMem    As Long
  733.     Dim pMem    As Long
  734.  
  735.     ' bytes + 4 to save the memory handle (for FreeBufferMem())
  736.     hMem = GlobalAlloc(GPTR, bytes + 4)
  737.     If hMem = 0 Then Exit Function
  738.  
  739.     pMem = GlobalLock(hMem)
  740.     If pMem = 0 Then Exit Function
  741.  
  742.     CpyMem ByVal pMem, hMem, 4
  743.  
  744.     ' return a pointer to the allocated memory,
  745.     ' but hide the memory handle
  746.     AllocBufferMem = pMem + 4
  747. End Function
  748.  
  749. Private Sub FreeBufferMem( _
  750.     ByVal buf_ptr As Long _
  751. )
  752.  
  753.     Dim hMem    As Long
  754.  
  755.     ' memory handle should be at (pointer - 4)
  756.     CpyMem hMem, ByVal buf_ptr - 4, 4
  757.  
  758.     GlobalUnlock hMem
  759.     GlobalFree hMem
  760. End Sub
  761.  
  762. ''''''''''''''''''''''''''''''''''''''''''''''
  763. ''''''''''''''''''''''''''''''''''''''''''''''
  764. ''''''''''''''''''''''''''''''''''''''''''''''
  765.  
  766. Private Function CreateFakeWnd( _
  767. ) As Long
  768.  
  769.     CreateFakeWnd = CreateWindowEx(0, "static", _
  770.                                    "clsWaveOut", 0, _
  771.                                    0, 0, 0, 0, _
  772.                                    0, 0, 0, 0)
  773.  
  774. End Function
  775.  
  776. Private Sub HookFakeWindow()
  777.     sc_Subclass hFakeWnd, 0, 1, Me, True
  778.     sc_AddMsg hFakeWnd, MM_WOM_DONE, MSG_AFTER
  779. End Sub
  780.  
  781. Private Sub UnhookFakeWindow()
  782.     sc_UnSubclass hFakeWnd
  783. End Sub
  784.  
  785. ''''''''''''''''''''''''''''''''''''''''''''''
  786. ''''''''''''''''''''''''''''''''''''''''''''''
  787. ''''''''''''''''''''''''''''''''''''''''''''''
  788.  
  789. Private Sub Class_Initialize()
  790.     udeStatus = WO_STOPPED
  791. End Sub
  792.  
  793. Private Sub Class_Terminate()
  794.     Deinit
  795. End Sub
  796.  
  797. ''''''''''''''''''''''''''''''''''''''''''''''
  798. ''''''''''''''''''''''''''''''''''''''''''''''
  799. ''''''''''''''''''''''''''''''''''''''''''''''
  800.  
  801. '-SelfSub code------------------------------------------------------------------------------------
  802. Private Function sc_Subclass( _
  803.     ByVal lng_hWnd As Long, _
  804.     Optional ByVal lParamUser As Long = 0, _
  805.     Optional ByVal nOrdinal As Long = 1, _
  806.     Optional ByVal oCallback As Object = Nothing, _
  807.     Optional ByVal bIdeSafety As Boolean = True _
  808. ) As Boolean 'Subclass the specified window handle
  809.  
  810. '*************************************************************************************************
  811. '* lng_hWnd   - Handle of the window to subclass
  812. '* lParamUser - Optional, user-defined callback parameter
  813. '* nOrdinal   - Optional, ordinal index of the callback procedure. 1 = last private method, 2 = second last private method, etc.
  814. '* oCallback  - Optional, the object that will receive the callback. If undefined, callbacks are sent to this object's instance
  815. '* bIdeSafety - Optional, enable/disable IDE safety measures. NB: you should really only disable IDE safety in a UserControl for design-time subclassing
  816. '*************************************************************************************************
  817.  
  818.     Const CODE_LEN      As Long = 260                                   'Thunk length in bytes
  819.     Const MEM_LEN       As Long = CODE_LEN + (8 * (MSG_ENTRIES + 1))    'Bytes to allocate per thunk, data + code + msg tables
  820.     Const PAGE_RWX      As Long = &H40&                                 'Allocate executable memory
  821.     Const MEM_COMMIT    As Long = &H1000&                               'Commit allocated memory
  822.     Const MEM_RELEASE   As Long = &H8000&                               'Release allocated memory flag
  823.     Const IDX_EBMODE    As Long = 3                                     'Thunk data index of the EbMode function address
  824.     Const IDX_CWP       As Long = 4                                     'Thunk data index of the CallWindowProc function address
  825.     Const IDX_SWL       As Long = 5                                     'Thunk data index of the SetWindowsLong function address
  826.     Const IDX_FREE      As Long = 6                                     'Thunk data index of the VirtualFree function address
  827.     Const IDX_BADPTR    As Long = 7                                     'Thunk data index of the IsBadCodePtr function address
  828.     Const IDX_OWNER     As Long = 8                                     'Thunk data index of the Owner object's vTable address
  829.     Const IDX_CALLBACK  As Long = 10                                    'Thunk data index of the callback method address
  830.     Const IDX_EBX       As Long = 16                                    'Thunk code patch index of the thunk data
  831.     Const SUB_NAME      As String = "sc_Subclass"                       'This routine's name
  832.       Dim nAddr         As Long
  833.       Dim nID           As Long
  834.       Dim nMyID         As Long
  835.   
  836.     If IsWindow(lng_hWnd) = 0 Then                                      'Ensure the window handle is valid
  837.         zError SUB_NAME, "Invalid window handle"
  838.         Exit Function
  839.     End If
  840.  
  841.     nMyID = GetCurrentProcessId                                         'Get this process's ID
  842.     GetWindowThreadProcessId lng_hWnd, nID                              'Get the process ID associated with the window handle
  843.     If nID <> nMyID Then                                                'Ensure that the window handle doesn't belong to another process
  844.         zError SUB_NAME, "Window handle belongs to another process"
  845.         Exit Function
  846.     End If
  847.   
  848.     If oCallback Is Nothing Then                                        'If the user hasn't specified the callback owner
  849.         Set oCallback = Me                                              'Then it is me
  850.     End If
  851.   
  852.     nAddr = zAddressOf(oCallback, nOrdinal)                             'Get the address of the specified ordinal method
  853.     If nAddr = 0 Then                                                   'Ensure that we've found the ordinal method
  854.         zError SUB_NAME, "Callback method not found"
  855.         Exit Function
  856.     End If
  857.     
  858.     If z_Funk Is Nothing Then                                           'If this is the first time through, do the onelParamER
  859. End Sub
  860.  
  861. Private S000
  862.  te S000
  863.  te S00SetVolue allocatenSubc= 0 Then Exit Function
  864.  
  865.     CpyMem Is Nothing Then                                           'Ia the window  hod address
  866.     Const4 process"
  867.         6******'''''''''
  868.     ude
  869.     DestroyWindow hFakeWnd
  870.     hF              dle '''''''''''ib
  871.  
  872. Priv    
  873.  te
  874.   yVal lpAddress As Long,
  875.     her process"
  876. ''''CAs Long
  877.  
  878.     CpyMem Is Nothing Then                    his proC          AsPrivate Declare Functio
  879.    
  880. Priiiiio      userdata As Long)
  881. Public Event StatusChanged(By   u                    'EEEEEEEEEEo the WndPro'ate ow Lib "user3 FunctiooooooooooooooooooooooooooooooooooooooooooooooooooDl lpuStat   'Ifd3l''CAsssssssssss=)
  882. Public EvEdr = z55555555     'EEEEEED SUB_NAME,'''''''''''rrorL Deeeeeeeeeeeeeeeeeeoooooooublic Event Statunction
  883.  nk dataex of ''''uSt
  884.     CpyMem s''''D EvEdr = z5555555Addr = zAddressOf
  885. End Fute Type WAVubclassing
  886. 'e/dis  Constndow  heu           pyMeminde1      .dwBufferLength = buf_len
  887.   ic Evedr32" (ByVal      ooooooyunctiooooooooooooooooooooooooooooooooooooo(
  888. 'e/dis  Cle   ooooooyunctioo      t
  889.     CpyMem s''''D EvEdr = z5555555Addr = zAddressOf
  890. EnnnnnnFute Type WAflic Sub Rel method
  891.    x  'Get fVersion
  892.  Ls         h = buf_l              I  API  CpyMem s'' the on      Mnnnnnnoooclassing
  893. 'e/dis  ConstndtSOutGetPosition hWO, udtTime, Len(udtTime)
  894.  
  895.     Select Case u  hF    As LulbackessDeiniTime)
  896. e S00SetVolue allocatenSubc= 0 Then Exiiii(udtTirst time through, do tO, udtTime,Bon
  897.     End If
  898.  
  899.     udeErr _
  900.   ndtSsoindow hf thocess     As Long
  901.       Dim nMyID         As Long
  902.   
  903.     If IsWindow(lng_hWnd) = 0 Then        
  904.  
  905. Privattttttttttt                      tttttttttt   ef  'Thunk dFunction ue al
  906.   'nnnoooclassin4,ddress
  907. tal hWaveOut As Long _
  908. ) As Long
  909.  
  910. Private Declare Function waveOutUnprepareHea5555555     'EEEEEED SUB_NAME,''m nMyID  Val device_id Function
  911.  
  912. ''''''''''''''''''''''''''''''''''" ( _MAT =assing
  913. 'e/Time, 3 6******'''''''''
  914.  E + 2)   ' hGetCurrentProcessId      Cle   ooooooyunctioo      t
  915.     CpyMem s''''D EvEdr = z55555
  916.      Lunctime thr, 3 6*3'''''''n3     I  API  CpyMem s'' the on      Mnnnon
  917. ame through, do tO, udtTioParam As z
  918.  
  919.     nobame.wType
  920.   zLong     aveO6555555Addr =
  921.       Dim nMy    L''''''''  nob2" (ByVe T5, do tO, udtTioParam As z
  922.  
  923.     nobame.wType
  924.   zLongthrougmethod
  925.     If nAddr  T5, do tO, udtTioParam As z
  926.  
  927.     nobame.wType
  928.   zLongt          unk lengtthe ssow hFakeWnd
  929.            ' hGetCurrentProcTirst time through, do tO          'EeAs WO_SzFunctio
  930. Subc= 0 Thenwave formnMyID  ValerQueue back method addre''''''
  931.  
  932. Private Sub ClaTtuuuuuuuuuuu
  933.  
  934.     F2v= 0 TheAErr  callback. If undefinedME_BYtCurrXS(ME_BYtCuaTtuuuuuuuuuuu
  935.  
  936.     F2v= 0 TheAErr  callYtCuaTtuuuuuution waveOutUnprepareHHHHHHHHHHHH ooooooyuncti                          'Thunk data index of the EbMode ERSIO00&-hhhhhh     3 4 _
  937. b<Is Nothing Th EbMode ERSIO00&-hhhhhh     3     3 4 _
  938. b<Is Nothing Th EbMode ERSIO00&-hhhhhh   t
  939.     Cp=pe
  940.   zLongt          unk lengtthe ssow hFahEnumoS   Const IDX_EB( zLAs Long = 1, _
  941.     Optional ByVal oCallback As ObjB( zLAsGetModhine-cng Th EbMode ERooDl              OptEr 7e As Long
  942. hunkam As z
  943.  
  944.   vateeeeeeee  t
  945.     CpyMem s'''''''''0000000000 FzbMod        unku8         5t t''''
  946.  E + 2)  udeStatus = WO_lass_IniCpyMem Is Status) Long = 1, _
  947.     Optional ByVal oCallback As ObjB( zLAsGetModhine-cng Th EbMode ERooDl              OptEr 7e As Long
  948. hunkam AekFak  3 4 _eStatu2'D              OptEr 7e As'''''''''''''' 4 _eStaw hFahatal tr4 _IIIIIIIIIIIIIIII)DnnnnnnnnnnnnnFakeWnd
  949.     _IniCpyMem Is Status) Long = 1, _
  950.     Op1, _
  951.     Op1,s proC   ee, 3 6**  Cle CI)Dnnnnnnnnnnnunk dat  Byyyyyyyyyyy8'''ize()
  952.     udeStatus = WO_E''''''''''_pe
  953.   zLong    , _
  954.     O.''''''B80ess
  955. tal hW       .////  4br'iyy8'''i*  CcCo
  956.    
  957. P8 _
  958. O_Sz
  959.  s      MSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12)   ' handle being used */
  960.                                                  ' simultaneously on another */
  961.                     , udtTioPaI)Dnnn TUS
  962.     WO_PLAYING =  tO, udtTio:   , ud + lngAddTime
  963. E'uuuution waveOutUnpre
  964.   zLonnnnnnnnnnahatal tr4 _IIIIIIIII     ''''''4
  965.  
  966. Private Declare FudtTioPaI)EDal >nass_ associated with'ong = &H40&  simultaneoustion waveORx5imulllllllllllllllllze()
  967.     udeStatus = WtCu9  Conste1   h.)
  968.     udeStatus =  ndtSsoindow hf thocess     As Long
  969.      tatm s'''''''''5555.................pe
  970.   zLongt          unk lengtthe ssow hFakeg = &H4ultnction Destr _
  971.           ctionste1   h.)
  972. 5z6indowEx
  973.         Set oCall       rxit F1    ByVal hfeclare Functio
  974.    
  975. Priiiiio    ctio
  976.    
  977. Priiiiio    ctvice_id, _
  978.                       
  979.         llback Is No theeeeeeeeeor WaveOu6tatus) Long = 1, _
  980.     Optional ByVal oCallba6************** imullliiio    ctio
  981.    
  982. Priiiiio    ctvice_id, _
  983.         D _
  984.      As Long
  985. hunkam AekFak  3 4 _g Th EbMode ERSIO00&-hhhhhh   t
  986.     Cp=pe
  987.   zLongt          unk lengtthe ssow hFahEnumoS   Con.(.)
  988. 5z6indowEx
  989.         Set oCall       rxit F1    ByVal hfeclare Functio
  990.    
  991. Priiiiio    ctio
  992.    
  993. Priiii5555...e Function CreateWindnback As ObjB( zLAtE)r32" (ByVal      oooooo Set oCall       rxit F1    ByVal hfeclare Functio
  994.  UUUUUUUUUUUUUUUUUUUUUooooyunctio    Cleyyyyy8'''ize()
  995. d, _
  996.         D _    If /
  997.  '''''''''''
  998.  
  999.  
  1000.