vbAccelerator - Contents of code file: cConverterWavePlayer.cls

This file is part of the download VB5 Winamp Plugin Client, which is described in the article Using WinAmp In Plugins From VB.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cConverterWavePlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Private Const WM_DESTROY = &H2&

Private Const CALLBACK_WINDOW = &H10000
Private Const WAVE_MAPPER = -1&
Private Const MM_WOM_DONE = &H3BD
Private Const MMSYSERR_NOERROR = 0
Private Const SEEK_CUR = 1
Private Const SEEK_END = 2
Private Const SEEK_SET = 0
Private Const TIME_BYTES = &H4
Private Const WHDR_DONE = &H1

' Wave formats:
Public Enum EWaveFormat
   WAVE_FORMAT_UNKNOWN = &H0        ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_PCM = &H1
   WAVE_FORMAT_ADPCM = &H2          ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_IEEE_FLOAT = &H3     ' /*  Microsoft Corporation  *' /
                                        ' /*  IEEE754: range (+1, -1]  *' /
                                        ' /*  32-bit' /64-bit format as defined
                                         by *' /
                                        ' /*  MSVC++ float' /double type *' /
   WAVE_FORMAT_IBM_CVSD = &H5       ' /*  IBM Corporation  *' /
   WAVE_FORMAT_ALAW = &H6           ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_MULAW = &H7          ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_OKI_ADPCM = &H10     ' /*  OKI  *' /
   WAVE_FORMAT_DVI_ADPCM = &H11     ' /*  Intel Corporation  *' /
   WAVE_FORMAT_MEDIASPACE_ADPCM = &H12      ' /*  Videologic  *' /
   WAVE_FORMAT_SIERRA_ADPCM = &H13          ' /*  Sierra Semiconductor Corp  *'
    /
   WAVE_FORMAT_G723_ADPCM = &H14    ' /*  Antex Electronics Corporation  *' /
   WAVE_FORMAT_DIGISTD = &H15       ' /*  DSP Solutions, Inc.  *' /
   WAVE_FORMAT_DIGIFIX = &H16       ' /*  DSP Solutions, Inc.  *' /
   WAVE_FORMAT_DIALOGIC_OKI_ADPCM = &H17    ' /*  Dialogic Corporation  *' /
   WAVE_FORMAT_MEDIAVISION_ADPCM = &H18     ' /*  Media Vision, Inc. *' /
   WAVE_FORMAT_YAMAHA_ADPCM = &H20          ' /*  Yamaha Corporation of America
     *' /
   WAVE_FORMAT_SONARC = &H21        ' /*  Speech Compression  *' /
   WAVE_FORMAT_DSPGROUP_TRUESPEECH = &H22           ' /*  DSP Group, Inc  *' /
   WAVE_FORMAT_ECHOSC1 = &H23       ' /*  Echo Speech Corporation  *' /
   WAVE_FORMAT_AUDIOFILE_AF36 = &H24        ' /*    *' /
   WAVE_FORMAT_APTX = &H25          ' /*  Audio Processing Technology  *' /
   WAVE_FORMAT_AUDIOFILE_AF10 = &H26        ' /*    *' /
   WAVE_FORMAT_DOLBY_AC2 = &H30     ' /*  Dolby Laboratories  *' /
   WAVE_FORMAT_GSM610 = &H31        ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_MSNAUDIO = &H32      ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_ANTEX_ADPCME = &H33          ' /*  Antex Electronics Corporation
     *' /
   WAVE_FORMAT_CONTROL_RES_VQLPC = &H34     ' /*  Control Resources Limited  *'
    /
   WAVE_FORMAT_DIGIREAL = &H35      ' /*  DSP Solutions, Inc.  *' /
   WAVE_FORMAT_DIGIADPCM = &H36     ' /*  DSP Solutions, Inc.  *' /
   WAVE_FORMAT_CONTROL_RES_CR10 = &H37      ' /*  Control Resources Limited  *'
    /
   WAVE_FORMAT_NMS_VBXADPCM = &H38          ' /*  Natural MicroSystems  *' /
   WAVE_FORMAT_CS_IMAADPCM = &H39   ' /* Crystal Semiconductor IMA ADPCM *' /
   WAVE_FORMAT_ECHOSC3 = &H3A       ' /* Echo Speech Corporation *' /
   WAVE_FORMAT_ROCKWELL_ADPCM = &H3B        ' /* Rockwell International *' /
   WAVE_FORMAT_ROCKWELL_DIGITALK = &H3C     ' /* Rockwell International *' /
   WAVE_FORMAT_XEBEC = &H3D         ' /* Xebec Multimedia Solutions Limited *' /
   WAVE_FORMAT_G721_ADPCM = &H40    ' /*  Antex Electronics Corporation  *' /
   WAVE_FORMAT_G728_CELP = &H41     ' /*  Antex Electronics Corporation  *' /
   WAVE_FORMAT_MPEG = &H50          ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_MPEGLAYER3 = &H55    ' /*  ISO' /MPEG Layer3 Format Tag *' /
   WAVE_FORMAT_CIRRUS = &H60        ' /*  Cirrus Logic  *' /
   WAVE_FORMAT_ESPCM = &H61         ' /*  ESS Technology  *' /
   WAVE_FORMAT_VOXWARE = &H62       ' /*  Voxware Inc  *' /
   WAVEFORMAT_CANOPUS_ATRAC = &H63          ' /*  Canopus, co., Ltd.  *' /
   WAVE_FORMAT_G726_ADPCM = &H64    ' /*  APICOM  *' /
   WAVE_FORMAT_G722_ADPCM = &H65    ' /*  APICOM      *' /
   WAVE_FORMAT_DSAT = &H66          ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_DSAT_DISPLAY = &H67          ' /*  Microsoft Corporation  *' /
   WAVE_FORMAT_SOFTSOUND = &H80     ' /*  Softsound, Ltd.      *' /
   WAVE_FORMAT_RHETOREX_ADPCM = &H100       ' /*  Rhetorex Inc  *' /
   WAVE_FORMAT_CREATIVE_ADPCM = &H200       ' /*  Creative Labs, Inc  *' /
   WAVE_FORMAT_CREATIVE_FASTSPEECH8 = &H202         ' /*  Creative Labs, Inc 
    *' /
   WAVE_FORMAT_CREATIVE_FASTSPEECH10 = &H203        ' /*  Creative Labs, Inc 
    *' /
   WAVE_FORMAT_QUARTERDECK = &H220  ' /*  Quarterdeck Corporation  *' /
   WAVE_FORMAT_FM_TOWNS_SND = &H300         ' /*  Fujitsu Corp.  *' /
   WAVE_FORMAT_BTV_DIGITAL = &H400          ' /*  Brooktree Corporation  *' /
   WAVE_FORMAT_OLIGSM = &H1000      ' /*  Ing C. Olivetti & C., S.p.A.  *' /
   WAVE_FORMAT_OLIADPCM = &H1001    ' /*  Ing C. Olivetti & C., S.p.A.  *' /
   WAVE_FORMAT_OLICELP = &H1002     ' /*  Ing C. Olivetti & C., S.p.A.  *' /
   WAVE_FORMAT_OLISBC = &H1003      ' /*  Ing C. Olivetti & C., S.p.A.  *' /
   WAVE_FORMAT_OLIOPR = &H1004      ' /*  Ing C. Olivetti & C., S.p.A.  *' /
   WAVE_FORMAT_LH_CODEC = &H1100    ' /*  Lernout & Hauspie  *' /
   WAVE_FORMAT_NORRIS = &H1400      ' /*  Norris Communications, Inc.  *' /

' /' /
' /' /  the WAVE_FORMAT_DEVELOPMENT format tag can be used during the
' /' /  development phase of a new wave format.  Before shipping, you MUST
' /' /  acquire an official format tag from Microsoft.
' /' /
   WAVE_FORMAT_DEVELOPMENT = &HFFFF
End Enum

Private Type mmioinfo
   dwFlags As Long
   fccIOProc As Long
   pIOProc As Long
   wErrorRet As Long
   htask As Long
   cchBuffer As Long
   pchBuffer As String
   pchNext As String
   pchEndRead As String
   pchEndWrite As String
   lBufOffset As Long
   lDiskOffset As Long
   adwInfo(4) As Long
   dwReserved1 As Long
   dwReserved2 As Long
   hmmio As Long
End Type

Private Type WAVEHDR
   lpData As Long
   dwBufferLength As Long
   dwBytesRecorded As Long
   dwUser As Long
   dwFlags As Long
   dwLoops As Long
   lpNext As Long
   Reserved As Long
End Type

Private Type WAVEINCAPS
   wMid As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * 32
   dwFormats As Long
   wChannels As Integer
End Type

Private Type WAVEFORMATEX
   wFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   wBitsPerSample As Integer
   cbSize As Integer
End Type

Private Type MMCKINFO
   ckid As Long
   ckSize As Long
   fccType As Long
   dwDataOffset As Long
   dwFlags As Long
End Type

Private Type MMTIME
   wType As Long
   u As Long
   x As Long
End Type

Private Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As
 Long, lpInfo As MMTIME, ByVal uSize As Long) As Long
Private Declare Function waveOutOpen Lib "winmm.dll" (hWaveOut As Long, ByVal
 uDeviceID As Long, ByVal format As String, ByVal dwCallback As Long, ByRef
 fPlaying As Boolean, ByVal dwFlags As Long) As Long
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As
 Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveIn As Long)
 As Long
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn
 As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveIn As Long)
 As Long
Private Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias
 "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal
 uSize As Long) As Long
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function waveOutGetErrorText Lib "winmm.dll" Alias
 "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize
 As Long) As Long
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long,
 lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long)
 As Long
Private Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As
 Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As
 Any, src As Any, ByVal cb As Long)
Private Declare Sub CopyMemoryFromString Lib "kernel32" Alias "RtlMoveMemory"
 (dest As Any, ByVal source As String, ByVal cb As Long)
Private Declare Function PostWavMessage Lib "USER32" Alias "PostMessageA"
 (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef hdr As
 WAVEHDR) As Long
Private Declare Sub SleepApi Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds
 As Long)

Private Const GMEM_FIXED = &H0
Private Const NUM_BUFFERS = 5

Implements ISubclass

Private Const cErrBase = 29670

Private m_hWnd As Long

Private m_bPlaying As Boolean

Private m_lPtrFormat As Long      ' pointer to wave format
Private m_tFormat As WAVEFORMATEX    ' waveformat structure

Private m_tHdr() As WAVEHDR    ' wave headers
Private m_lBufferSize As Long ' size of buffer

Private m_hWaveOut As Long        ' waveout handle

Private m_cConverter As cWinAmpAudioConverter

Public Event Progress(ByVal lTime As Long)
Public Event Complete()


Public Sub Attach(ByVal hWnd As Long)
   m_hWnd = hWnd
   AttachMessage Me, m_hWnd, MM_WOM_DONE
   AttachMessage Me, m_hWnd, WM_DESTROY
End Sub
Public Sub Detach()
   If m_hWnd Then
      DetachMessage Me, m_hWnd, MM_WOM_DONE
      DetachMessage Me, m_hWnd, WM_DESTROY
      m_hWnd = 0
   End If
End Sub

Private Sub pErrorHandler(ByVal lR As Long)
Dim sMsg As String
Dim iPos As Long
   sMsg = String$(260, 0)
   waveOutGetErrorText lR, sMsg, Len(sMsg)
   iPos = InStr(sMsg, vbNullChar)
   If Not iPos = 0 Then
      sMsg = Left$(sMsg, iPos - 1)
   End If
   err.Raise cErrBase + lR + 10, App.EXEName & ".cWavePlayer", sMsg
End Sub

Private Sub pInternalErrorHandler(ByVal lR As Long)
Dim sMsg As String
   Select Case lR
   Case 1
      sMsg = "Class not ready; call attach method first."
   Case 2
      sMsg = "Unable to open file."
   Case 3
      sMsg = "Not a Wave file."
   Case 4
      sMsg = "Unable to retrieve format chunk"
   Case 5
      sMsg = "Error reading format"
   Case 6
      sMsg = "No Wave File Open"
   Case 7
      sMsg = "Insufficient memory"
   Case 8
      sMsg = "Position out of range"
   Case 9
      sMsg = "No wave file playing"
   Case 10
      sMsg = "Buffer time out of range, choose a number of second between 0.001
       and 10"
   End Select
   err.Raise cErrBase + lR, App.EXEName & ".cWavePlayer", sMsg
End Sub

Public Function Play(cConverter As cWinAmpAudioConverter) As Boolean
Dim lR As Long
Dim sFormatBuffer As String
Dim iBuffer As Long

   Debug.Print "Play Called", m_hWaveOut
   If (m_bPlaying) Then
      StopPlay
   End If

   Set m_cConverter = cConverter

   If m_hWnd = 0 Then
      pInternalErrorHandler 1
      Exit Function
   End If
          
   ' Standard 16bit 44.1kHz stereo wav
   m_tFormat.nAvgBytesPerSec = 176400
   m_tFormat.nBlockAlign = 4
   m_tFormat.nChannels = 2
   m_tFormat.nSamplesPerSec = 44100
   m_tFormat.wBitsPerSample = 16
   m_tFormat.wFormatTag = WAVE_FORMAT_PCM
   
   m_lBufferSize = cConverter.ConvertChunk(1)
   cConverter.TrackSeek 0
       
   sFormatBuffer = String$(50, 0)
   CopyMemory ByVal sFormatBuffer, m_tFormat, LenB(m_tFormat)
   lR = waveOutOpen(m_hWaveOut, WAVE_MAPPER, sFormatBuffer, m_hWnd, True,
    CALLBACK_WINDOW)
    
   If Not (lR = MMSYSERR_NOERROR) Then
      pErrorHandler lR
      Play = False
      Exit Function
   End If

   ReDim m_tHdr(1 To cConverter.BufferCount) As WAVEHDR
   For iBuffer = 1 To cConverter.BufferCount
      With m_tHdr(iBuffer)
         .lpData = cConverter.ReadBufferPtr(iBuffer)
         .dwBufferLength = m_lBufferSize
         .dwUser = iBuffer
         .dwFlags = 0
         .dwLoops = 0
      End With
      lR = waveOutPrepareHeader(m_hWaveOut, m_tHdr(iBuffer),
       LenB(m_tHdr(iBuffer)))
      If Not (lR = MMSYSERR_NOERROR) Then
         pErrorHandler lR
      End If
   Next iBuffer

   m_bPlaying = True
   Play = True
    
   ' Start playing by posting callback functions to read into
   ' the buffers & play:
   For iBuffer = 1 To cConverter.BufferCount
      PostWavMessage m_hWnd, MM_WOM_DONE, 0, m_tHdr(iBuffer)
   Next
    
End Function

Public Sub StopPlay()
   If m_bPlaying Then
      m_bPlaying = False
      waveOutReset m_hWaveOut
      Do While Not (m_hWaveOut = 0)
         DoEvents
         Debug.Print "Waiting for close"
      Loop
   End If
End Sub

Public Function FileSeek(ByVal Position As Long) As Boolean
   '
   m_cConverter.TrackSeek Position
   '
End Function

Public Sub Pause(ByVal bState As Boolean)
   If m_hWaveOut = 0 Then
      pInternalErrorHandler 9
   End If
   If bState Then
      waveOutPause m_hWaveOut
   Else
      waveOutRestart m_hWaveOut
   End If
End Sub

Public Property Get Position() As Long
   '
   Position = m_cConverter.TrackCurrentTime
   '
End Property

Public Property Get Playing() As Boolean
Dim tMMT As MMTIME
Dim lR As Long
    
   If Not (m_hWaveOut = 0) Then
      tMMT.wType = TIME_BYTES
      lR = waveOutGetPosition(m_hWaveOut, tMMT, LenB(tMMT))
      If (lR = MMSYSERR_NOERROR) Then
         Playing = True
      Else
         Playing = False
      End If
   End If
End Property



Private Sub Class_Terminate()
   
   ' Stop playing and clear up:
   StopPlay
   
   On Error Resume Next
   Detach
   
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
   '
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
   ' Windows processes messages first:
   ISubclass_MsgResponse = emrPreprocess
End Property

Private Function ISubclass_WindowProc(ByVal hWnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tWavHdr As WAVEHDR
Dim lR As Long
Dim lReadSize As Long
Dim bCalledRead As Boolean
Dim lWriteSize As Long
Dim iBuffer As Long
    
   Select Case iMsg
   Case MM_WOM_DONE
   
      ' Get the WAVEHDR structure for this call:
      CopyMemory tWavHdr, ByVal lParam, 24
      
      If (m_bPlaying) Then
         ' Get the data from the converter:
         lReadSize = m_cConverter.ConvertChunk(tWavHdr.dwUser)
         
         ' Write the amount of data we just read into the
         ' memory buffer to the output sound device output buffer.
         If (lReadSize > 0) Then
            
            tWavHdr.dwBufferLength = lReadSize
            CopyMemory ByVal lParam, tWavHdr, 24
            
            lWriteSize = waveOutWrite(m_hWaveOut, ByVal lParam, LenB(tWavHdr))
            
            If (tWavHdr.dwUser = m_cConverter.BufferCount) Then
               RaiseEvent Progress(m_cConverter.TrackCurrentTime)
            End If
            
         End If
      End If


      ' Ensure we close all buffers
      If Not (m_bPlaying) Or (lReadSize = 0) Then
         waveOutUnprepareHeader m_hWaveOut, m_tHdr(tWavHdr.dwUser),
          LenB(m_tHdr(tWavHdr.dwUser))
         
         If (m_bPlaying And lReadSize = 0) Then
            RaiseEvent Complete
         End If
         
         ' Once we have finished with the buffer we can close the buffer:
         lR = waveOutClose(m_hWaveOut)
         If (lR = MMSYSERR_NOERROR) Then
            m_hWaveOut = 0
         End If
         
         m_bPlaying = False
      End If
      
   Case WM_DESTROY
      ' The app is closing but this class is still attached;
      ' we should try and clear up as a courtesy to the developer:
      On Error Resume Next
      StopPlay
      
      Detach
   End Select
   
End Function