VB Forum / Win API / July 2007

Hello.

------------------------------------
Here the user control's code so far :
------------------------------------

Option Explicit
Option Base 0

Dim caps() As tWaveInCaps
Dim wFormat As tWaveFormat

Dim inData8a(4095) As Byte
Dim inData16a(4095) As Integer
Dim inData8b(4095) As Byte
Dim inData16b(4095) As Integer
Dim inData8c(4095) As Byte
Dim inData16c(4095) As Integer

' Dim lpPrevWndProc As Long

Dim Sampling As Boolean
Dim Xfering As Boolean

Public Event opened()
Public Event closed()

Private Sub PauseBtn_Click()

   Call StopSampling
   MicOffImg.Visible = True
   MicOnImg.Visible = False
   PauseBtn.Enabled = False
   RecBtn.Enabled = True

End Sub

Private Sub RecBtn_Click()

   Call StartSampling
   MicOffImg.Visible = False
   MicOnImg.Visible = True
   RecBtn.Enabled = False
   PauseBtn.Enabled = True

End Sub

Private Sub UserControl_Initialize()

   ' Find all input devices
   Dim i As Long
   Dim ndevs As Long
   Dim rc As Long
   Dim msg As String
   Dim devname As String

'    ' save old window proc address
'    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

   Sampling = False
   Xfering = False

   Set UsrCtl = Me

'    hWnd = hwndIn
'    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

   ndevs = waveInGetNumDevs
   If ndevs > 0 Then
       ReDim caps(ndevs)
       For i = 0 To ndevs - 1
           Call waveInGetDevCaps(i, VarPtr(caps(i)), Len(caps(i)))
           devname = Left(StrConv(caps(i).ProductName, vbUnicode), 32)
           devname = Left(devname, InStr(devname + Chr(0), Chr(0)) - 1)
           Call DevicesBox.AddItem(devname, i)
       Next
       DevicesBox.ListIndex = 0
       If ndevs > 1 Then
           DevicesBox.Enabled = True
       End If
   Else
       DevicesBox.ListIndex = -1
   End If

   Call SetDefaultSrcParams

   '   Open mixer
'    rc = mixerOpen(hMx, 0, AddressOf MixerChangeProc, 0, CALLBACK_FUNCTION)
'    RetValue = mixerOpen(hmx, 0, 0, 0, 0)
'    If rc <> MMSYSERR_NOERROR Then
'       Call mciGetErrorString(rc, msg, Len(msg))
'       Call MsgBox("Mixer didn't open (" + Str(rc) + "): " + msg,
vbExclamation, "Ack!")
'       Exit Sub
'    End If

End Sub

Private Sub UserControl_Terminate()

   If Sampling Then
       Call StopSampling
   End If

'    mixerClose hmx
'    RetValue = SetWindowLong(Me.hWnd, GWL_WNDPROC, oldWndProc)

End Sub

Private Sub DevicesBox_Change()
   MsgBox ("deviceboxchage")
End Sub

Private Sub SetDefaultSrcParams()

   Dim i As Integer
   Dim j As Integer

   j = DevicesBox.ListIndex

   MicOffImg.Visible = False
   MicOnImg.Visible = False

   PauseBtn.Visible = False
   RecBtn.Visible = False
   AutoStart.Visible = False

   lVol.Visible = False
   Vol.Visible = False
   Vol.Enabled = False
   VolJauge.Visible = False
   BufferJauge.Visible = False
   WaveView.Visible = False
   SmplInd.Visible = False
   XferInd.Visible = False
   OvrInd.Visible = False

   lSamplesperSec.Visible = False
   lNrofChannels.Visible = False
   lSampleSize.Visible = False
   lFrameSize.Visible = False
   lNbBuffers.Visible = False

   SamplesperSec.Visible = False
   SamplesperSec.Enabled = False
   SamplesperSec.Clear

   NrofChannels.Visible = False
   NrofChannels.Enabled = False
   NrofChannels.Clear

   SampleSize.Visible = False
   SampleSize.Enabled = False
   SampleSize.Clear

   FrameSize.Visible = False
   FrameSize.Enabled = False
   FrameSize.Clear

   NbBuffers.Visible = False
   NbBuffers.Enabled = False
   NbBuffers.Clear

   If j >= 0 Then

       MicOffImg.Visible = True

       PauseBtn.Visible = True
       RecBtn.Visible = True
       RecBtn.Enabled = True
       AutoStart.Visible = True

       lVol.Visible = True
       Vol.Visible = True
       Vol.Enabled = True

       lSamplesperSec.Visible = True
       lNrofChannels.Visible = True
       lSampleSize.Visible = True
       lFrameSize.Visible = True

       ' Samples per second
       i = 0
       If (caps(j).Formats And WAVE_FORMAT_1xxx) Then
           SamplesperSec.AddItem ("11025")
           i = i + 1
       End If
       If (caps(j).Formats And WAVE_FORMAT_2xxx) Then
           SamplesperSec.AddItem ("22050")
           i = i + 1
       End If
       If caps(j).Formats And WAVE_FORMAT_4xxx Then
           SamplesperSec.AddItem ("44100")
           i = i + 1
       End If
       If caps(j).Formats And WAVE_FORMAT_8xxx Then
           SamplesperSec.AddItem ("48000")
           i = i + 1
       End If
       If caps(j).Formats And WAVE_FORMAT_1xxxx Then
           i = i + 1
           SamplesperSec.AddItem ("96000")
       End If
       If i = 0 Then
           MsgBox ("Not known sampling rate detected")
       Else
           SamplesperSec.ListIndex = 0
           If i > 1 Then
               SamplesperSec.Enabled = True
           End If
           SamplesperSec.Visible = True
       End If

       ' Nr of channels (mono/stereo)
       i = 0
       If caps(j).Formats And WAVE_FORMAT_xMxx Then
           NrofChannels.AddItem ("Mono")
           i = i + 1
       End If
       If caps(j).Formats And WAVE_FORMAT_xSxx Then
           NrofChannels.AddItem ("Stereo")
           i = i + 1
       End If
       If i = 0 Then
           MsgBox ("No known polyphony indicator detected")
       Else
           NrofChannels.ListIndex = 0 'start in mono
           If i > 1 Then
               NrofChannels.Enabled = True
           End If
           NrofChannels.Visible = True
       End If

       ' Sample size
       i = 0
       If caps(j).Formats And WAVE_FORMAT_xx08 Then
           SampleSize.AddItem ("8")
           i = i + 1
       End If
       If caps(j).Formats And WAVE_FORMAT_xx16 Then
           SampleSize.AddItem ("16")
           i = i + 1
       End If
       If i > 0 Then
           SampleSize.ListIndex = 0
           If i > 1 Then
               SampleSize.Enabled = True
           End If
           SampleSize.Visible = True
       Else
           MsgBox ("No known sample size detected")
       End If

       ' Frame sizes
       FrameSize.AddItem ("256")
       FrameSize.AddItem ("512")
       FrameSize.AddItem ("1024")
       FrameSize.AddItem ("2048")
       FrameSize.AddItem ("4096")
       FrameSize.ListIndex = 0
       FrameSize.Visible = True
       FrameSize.Enabled = True

       ' Nb Buffers
       NbBuffers.AddItem ("1")
       NbBuffers.AddItem ("2")
       NbBuffers.AddItem ("3")
       NbBuffers.ListIndex = 0
       NbBuffers.Visible = True
       NbBuffers.Enabled = True

   End If

End Sub

Private Sub StartSampling()

   Dim rc As Long
   Dim msg As String

   With wFormat
       .FormatTag = WAVE_FORMAT_PCM
       .Channels = NrofChannels.ListIndex + 1
       .SamplesperSec = Val(SamplesperSec)
       .BitsPerSample = Val(SampleSize)
       .BlockAlign = (.Channels * .BitsPerSample) \ 8
       .AvgBytesPerSec = .BlockAlign * .SamplesperSec
       .ExtraDataSize = 0
       MsgBox ("fmt:" + Str(.FormatTag) + _
              " chan:" + Str(.Channels) + _
              " smpl/s:" + Str(.SamplesperSec) + _
              " bits/smpl:" + Str(.BitsPerSample) + _
              " blokalign:" + Str(.BlockAlign) + _
              " avgbyt/s:" + Str(.AvgBytesPerSec) + _
              " extradsiz:" + Str(.ExtraDataSize) + _
              " Framesz:" + Str(Val(FrameSize)))
   End With

   ' msgbox ("startsampling")
   '***rc = waveInOpen(hDev, DevicesBox.ListIndex, VarPtr(wFormat), hWnd,
True, CALLBACK_WINDOW)
   '**rc = waveInOpen(hDev, WAVE_MAPPER, VarPtr(wFormat), AddressOf
MicSrcMod.waveInProcB, 0, CALLBACK_FUNCTION Or WAVE_MAPPED)
   '** rc = waveInOpen(hDev, WAVE_MAPPER, VarPtr(wFormat), AddressOf
MicSrcMod.waveInProc, 0, CALLBACK_FUNCTION)
   rc = waveInOpen(hDev, DevicesBox.ListIndex, VarPtr(wFormat), AddressOf
MicSrcMod.waveInProc, 0, CALLBACK_FUNCTION)
   'rc = waveInOpen(hDev, DevicesBox.ListIndex, VarPtr(wFormat), 0, 0, 0)
   ' msgbox ("waveinopen ended")
   If rc <> 0 Then
      waveInGetErrorText rc, msg, Len(msg)
      Call MsgBox("Wave input device didn't open (" + Str(rc) + "): " +
msg, vbExclamation, "Ack!")
      Exit Sub
   End If
   ' msgbox ("waveinopen succeeded")

   ' first buffer
   If wFormat.BitsPerSample = 16 Then wHdra.lpData = VarPtr(inData16a(0))
Else wHdra.lpData = VarPtr(inData8a(0))
   wHdra.dwBufferLength = Val(FrameSize) * wFormat.BlockAlign
   wHdra.dwFlags = 0
   MsgBox ("lpdata:" + Str(wHdra.lpData) + _
          " buflen:" + Str(wHdra.dwBufferLength) + _
          " flags:" + Str(wHdra.dwFlags))
   rc = waveInPrepareHeader(hDev, VarPtr(wHdra), Len(wHdra))
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in prepare header a has failed (" + Str(rc) + "):
" + msg, vbExclamation, "Ack!")
       Exit Sub
   End If
   rc = waveInAddBuffer(hDev, VarPtr(wHdra), Len(wHdra))
   If rc <> 0 Then
       Call MsgBox("Wave in add buffer a has failed (" + Str(rc) + "): " +
msg, vbExclamation, "Ack!")
   End If

   If Val(NbBuffers) > 1 Then
   ' second buffer
       If wFormat.BitsPerSample = 16 Then wHdrb.lpData =
VarPtr(inData16b(0)) Else wHdrb.lpData = VarPtr(inData8b(0))
       wHdrb.dwBufferLength = Val(FrameSize) * wFormat.BlockAlign
       wHdrb.dwFlags = 0
       rc = waveInPrepareHeader(hDev, VarPtr(wHdrb), Len(wHdrb))
       If rc <> 0 Then
           waveInGetErrorText rc, msg, Len(msg)
           Call MsgBox("Wave in prepare header b has failed (" + Str(rc) +
"): " + msg, vbExclamation, "Ack!")
           Exit Sub
       End If
       rc = waveInAddBuffer(hDev, VarPtr(wHdrb), Len(wHdrb))
       If rc <> 0 Then
           waveInGetErrorText rc, msg, Len(msg)
           Call MsgBox("Wave in add buffer b has failed (" + Str(rc) + "):
" + msg, vbExclamation, "Ack!")
       End If
       If Val(NbBuffers) > 2 Then
   ' third (and last possible) buffer
           If wFormat.BitsPerSample = 16 Then wHdrc.lpData =
VarPtr(inData16c(0)) Else wHdrc.lpData = VarPtr(inData8c(0))
           wHdrc.dwBufferLength = Val(FrameSize) * wFormat.BlockAlign
           wHdrc.dwFlags = 0
           rc = waveInPrepareHeader(hDev, VarPtr(wHdrc), Len(wHdrc))
           If rc <> 0 Then
               waveInGetErrorText rc, msg, Len(msg)
               Call MsgBox("Wave in prepare header c has failed (" +
Str(rc) + "): " + msg, vbExclamation, "Ack!")
               Exit Sub
           End If
           rc = waveInAddBuffer(hDev, VarPtr(wHdrc), Len(wHdrc))
           If rc <> 0 Then
               waveInGetErrorText rc, msg, Len(msg)
               Call MsgBox("Wave in add buffer c has failed (" + Str(rc) +
"): " + msg, vbExclamation, "Ack!")
           End If
       End If
   End If

   ' msgbox ("wavein prepare headers and addbuffers succeeded")

'   start recording

   rc = waveInStart(hDev)
   If rc <> 0 Then
      waveInGetErrorText rc, msg, Len(msg)
      Call MsgBox("Wave input start has failed (" + Str(rc) + "): " + msg,
vbExclamation, "Ack!")
      Exit Sub
   End If
   ' msgbox ("waveinstart succeeded")

'    Do
'        DoEvents
'        'Just wait for the blocks to be done or the device to close
'    Loop Until ((wHdra.dwFlags And WHDR_DONE) = WHDR_DONE) Or hDev = 0

   ' no update of sampling params, while sampling ...
   SamplesperSec.Enabled = False
   NrofChannels.Enabled = False
   SampleSize.Enabled = False
   FrameSize.Enabled = False
   NbBuffers.Enabled = False

   VolJauge.Visible = True
   BufferJauge.Visible = True
   WaveView.Visible = True

   RaiseEvent opened

'    Do
'    'Just wait for the blocks to be done or the device to close
'    Loop Until ((Wave.dwFlags And WHDR_DONE) = WHDR_DONE) Or DevHandle = 0
'

End Sub

Private Sub StopSampling()

   Dim rc As Long
   Dim msg As String

   ' reset
   rc = waveInReset(hDev)
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in close has failed (" + Str(rc) + "): " + msg,
vbExclamation, "Ack!")
   End If
   ' msgbox ("waveinreset succeeded")

   ' stop
   rc = waveInStop(hDev)
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in stop has failed (" + Str(rc) + "): " + msg,
vbExclamation, "Ack!")
   End If
   ' msgbox ("waveinstop succeeded")

   ' unprepare headers
   rc = waveInUnprepareHeader(hDev, VarPtr(wHdra), Len(wHdra))
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in unprepared header a has failed (" + Str(rc) +
"): " + msg, vbExclamation, "Ack!")
   End If
   rc = waveInUnprepareHeader(hDev, VarPtr(wHdrb), Len(wHdrb))
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in unprepared header b has failed (" + Str(rc) +
"): " + msg, vbExclamation, "Ack!")
   End If
   rc = waveInUnprepareHeader(hDev, VarPtr(wHdra), Len(wHdra))
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in unprepared header c has failed (" + Str(rc) +
"): " + msg, vbExclamation, "Ack!")
   End If
   ' msgbox ("waveinunprephdr succeeded")

   ' close
   rc = waveInClose(hDev)
   If rc <> 0 Then
       waveInGetErrorText rc, msg, Len(msg)
       Call MsgBox("Wave in close has failed (" + Str(rc) + "): " + msg,
vbExclamation, "Ack!")
   End If
   ' msgbox ("waveinclose succeeded")

   hDev = 0

   VolJauge.Visible = False
   BufferJauge.Visible = False
   WaveView.Visible = False

   ' allow again update of sampling params
   SamplesperSec.Enabled = True
   NrofChannels.Enabled = True
   SampleSize.Enabled = True
   FrameSize.Enabled = True
   NbBuffers.Enabled = True

   RaiseEvent closed

End Sub

Private Sub Vol_Change()

'Le volume est exprimé en pourcentage (entre 0 et 100)
'la fonction returne true si ca a fonctionné

   Dim uMixerLine As MIXERLINE
   Dim uMixerControl As MIXERCONTROL
   Dim nMixerDevs As Integer
   Dim uMixerLineControls As MIXERLINECONTROLS
   Dim uDetails As MIXERCONTROLDETAILS
   Dim uUnsigned As MIXERCONTROLDETAILS_UNSIGNED
   Dim uBoolean As MIXERCONTROLDETAILS_BOOLEAN

   Dim hMx As Long

   Dim RetValue As Long
   Dim hMem As Long
   Dim i, maxWavInSources As Long

   If Vol.Value < 0 Or Vol.Value > 100 Then GoTo error

   ' First find the WAVEIN Line
   uMixerLine.cbStruct = Len(uMixerLine)
   uMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_WAVEIN
   RetValue = mixerGetLineInfo(hMx, uMixerLine,
MIXER_GETLINEINFOF_COMPONENTTYPE)
   If RetValue <> MMSYSERR_NOERROR Then GoTo error

   ' Next enumerate the connections for this line, looking for the
Microphone
   maxWavInSources = uMixerLine.cConnections - 1

   For i = 0 To maxWavInSources
       uMixerLine.dwSource = i
       RetValue = mixerGetLineInfo(hMx, uMixerLine,
MIXER_GETLINEINFOF_SOURCE)
       If RetValue <> MMSYSERR_NOERROR Then GoTo error
       If uMixerLine.dwComponentType =
MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE Then
           Exit For
       End If
   Next

   ' If no microphone was found, exit
   If i > maxWavInSources Then GoTo error

   ' find microphone volume control
   uMixerLineControls.cbStruct = Len(uMixerLineControls)
   uMixerLineControls.dwLineID = uMixerLine.dwLineID
   uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
   uMixerLineControls.cControls = 1
   uMixerLineControls.cbmxctrl = Len(uMixerControl)

   hMem = GlobalAlloc(&H40, Len(uMixerControl))
   uMixerLineControls.pamxctrl = GlobalLock(hMem)
   uMixerControl.cbStruct = Len(uMixerControl)
   RetValue = mixerGetLineControls(hMx, uMixerLineControls,
MIXER_GETLINECONTROLSF_ONEBYTYPE)
   If RetValue <> MMSYSERR_NOERROR Then
       GlobalFree hMem
       hMem = 0
       GoTo error
   End If
   CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl,
Len(uMixerControl)
   GlobalFree hMem
   hMem = 0

   uDetails.item = 0
   uDetails.dwControlID = uMixerControl.dwControlID
   uDetails.cbStruct = Len(uDetails)
   uDetails.cbDetails = Len(uUnsigned)
   hMem = GlobalAlloc(&H40, Len(uUnsigned))
   uDetails.paDetails = GlobalLock(hMem)
   uDetails.cChannels = 1
   uUnsigned.dwValue = CLng((Vol.Value * uMixerControl.lMaximum) / 100)
   CopyMemory ByVal uDetails.paDetails, uUnsigned, Len(uUnsigned)
   RetValue = mixerSetControlDetails(hMx, uDetails,
MIXER_SETCONTROLDETAILSF_VALUE)

   GlobalFree hMem
   hMem = 0
   If RetValue <> MMSYSERR_NOERROR Then GoTo error

'    ' find microphone mute control
'    uMixerLineControls.cbStruct = Len(uMixerLineControls)
'    uMixerLineControls.dwLineID = uMixerLine.dwLineID
'    uMixerLineControls.dwControl = MIXERCONTROL_CT_CLASS_SWITCH '
MIXERCONTROL_CONTROLTYPE_MUTE
'    uMixerLineControls.cControls = 1
'    uMixerLineControls.cbmxctrl = Len(uMixerControl)
'    hMem = GlobalAlloc(&H40, Len(uMixerControl))
'    uMixerLineControls.pamxctrl = GlobalLock(hMem)
'    uMixerControl.cbStruct = Len(uMixerControl)
'
'    RetValue = mixerGetLineControls(hmx, uMixerLineControls,
MIXER_GETLINECONTROLSF_ONEBYTYPE) ' MIXERR_INVALCONTROL
'    If RetValue <> MMSYSERR_NOERROR Then
'        GlobalFree hMem
'        hMem = 0
'        Exit Function
'    End If
'    CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl,
Len(uMixerControl)
'    GlobalFree hMem
'    hMem = 0
'
   'Get the controldetailvalue
   RetValue = mixerGetControlDetails(hMx, uDetails, MIXER_OBJECTF_HMIXER Or
MIXER_GETCONTROLDETAILSF_VALUE)
   If RetValue <> MMSYSERR_NOERROR Then GoTo error

   CopyStructFromPtr uBoolean, uDetails.paDetails, Len(uBoolean)

'    MicMuted = CBool(uBoolean.dwValue)
'    MicOn.Visible = Not (MicMuted)
'    MicOff.Visible = MicMuted

'    If Vol.Value > 0 Then
'        ' if volume is greater than zero, ensure the mic line is not muted
'        If MicMuted Then
'            uDetails.item = 0
'            uDetails.dwControlID = uMixerControl.dwControlID
'            uDetails.cbStruct = Len(uDetails)
'            uDetails.cbDetails = Len(uBoolean)
'            hMem = GlobalAlloc(&H40, Len(uBoolean))
'            uDetails.paDetails = GlobalLock(hMem)
'            uDetails.cChannels = 1
'            uBoolean.dwValue = CLng(False)
'            CopyMemory ByVal uDetails.paDetails, uBoolean, Len(uBoolean)
'            RetValue = mixerSetControlDetails(hmx, uDetails,
MIXER_SETCONTROLDETAILSF_VALUE)
'            GlobalFree hMem
'            hMem = 0
'            If RetValue <> MMSYSERR_NOERROR Then GoTo error
'        End If
'    Else
'    ' volume is zero; we mute the mic line if not yet done
'        If Not MicMuted Then
'            ' if volume is greater than zero, ensure the mic line is not
muted
'            uDetails.item = 0
'            uDetails.dwControlID = uMixerControl.dwControlID
'            uDetails.cbStruct = Len(uDetails)
'            uDetails.cbDetails = Len(uBoolean)
'            hMem = GlobalAlloc(&H40, Len(uBoolean))
'            uDetails.paDetails = GlobalLock(hMem)
'            uDetails.cChannels = 1
'            uBoolean.dwValue = CLng(True)
'            CopyMemory ByVal uDetails.paDetails, uBoolean, Len(uBoolean)
'            RetValue = mixerSetControlDetails(hmx, uDetails,
MIXER_SETCONTROLDETAILSF_VALUE)
'            GlobalFree hMem
'            hMem = 0
'            If RetValue <> MMSYSERR_NOERROR Then GoTo error
'        End If
'    End If

error:
   ' Une erreur s'est produite

   If hMx <> 0 Then mixerClose hMx
   If hMem Then GlobalFree hMem

End Sub

Public Property Get SrcID() As Integer
   SrcID = DevicesBox.ListIndex
End Property

Public Property Let SrcID(ByVal v As Integer)
   If v >= 0 And v <= DevicesBox.ListCount - 1 Then
       DevicesBox.ListIndex = v
   End If
End Property

Public Property Let gotData(ByVal v As Integer)
   MsgBox ("Finally, got data ! ... " + Str(v))
End Property

--------------------------------------
and here the standard module's code :
--------------------------------------

Option Base 0
Option Explicit

Public Const WAVE_INVALIDFORMAT = &H0&                 '/* invalid format */

Public Const WAVE_FORMAT_xx08 = &H3333&                '/* Any 08-bit
Public Const WAVE_FORMAT_xx16 = &HCCCC&                '/* Any 16-bit

Public Const WAVE_FORMAT_xMxx = &H5555&                '/* Any Mono
Public Const WAVE_FORMAT_xSxx = &HAAAA&                '/* Any Stereo

Public Const WAVE_FORMAT_1xxx = &HF&                   '/* Any 11.025 kHz
Public Const WAVE_FORMAT_2xxx = &HF0&                  '/* Any 22.05 kHz
Public Const WAVE_FORMAT_4xxx = &HF00&                 '/* Any 44.1 kHz
Public Const WAVE_FORMAT_8xxx = &HF000&                '/* Any 48 kHz
Public Const WAVE_FORMAT_1xxxx = &HF0000               '/* Any 96 kHz

Public Const WAVE_FORMAT_1M08 = &H1&                   '/* 11.025 kHz, Mono,
8-bit
Public Const WAVE_FORMAT_1S08 = &H2&                   '/* 11.025 kHz,
Stereo, 8-bit
Public Const WAVE_FORMAT_1M16 = &H4&                   '/* 11.025 kHz, Mono,
16-bit
Public Const WAVE_FORMAT_1S16 = &H8&                   '/* 11.025 kHz,
Stereo, 16-bit
Public Const WAVE_FORMAT_2M08 = &H10&                  '/* 22.05  kHz, Mono,
8-bit
Public Const WAVE_FORMAT_2S08 = &H20&                  '/* 22.05  kHz,
Stereo, 8-bit
Public Const WAVE_FORMAT_2M16 = &H40&                  '/* 22.05  kHz, Mono,
16-bit
Public Const WAVE_FORMAT_2S16 = &H80&                  '/* 22.05  kHz,
Stereo, 16-bit
Public Const WAVE_FORMAT_4M08 = &H100&                 '/* 44.1   kHz, Mono,
8-bit
Public Const WAVE_FORMAT_4S08 = &H200&                 '/* 44.1   kHz,
Stereo, 8-bit
Public Const WAVE_FORMAT_4M16 = &H400&                 '/* 44.1   kHz, Mono,
16-bit
Public Const WAVE_FORMAT_4S16 = &H800&                 '/* 44.1   kHz,
Stereo, 16-bit

Public Const WAVE_FORMAT_PCM = 1

Public Const WAVE_MAPPER = -1
Public Const WAVE_MAPPED = &H4

'  flags for dwFlags field of WAVEHDR
Public Const WHDR_DONE = &H1&               '/* done bit */
Public Const WHDR_PREPARED = &H2&           '/* set if this header has been
prepared */
Public Const WHDR_BEGINLOOP = &H4&          '/* loop start block */
Public Const WHDR_ENDLOOP = &H8&            '/* loop end block */
Public Const WHDR_INQUEUE = &H10&           '/* reserved for driver */
Public Const WHDR_VALID = &H1F              ' valid flags   / ;Internal /

Public Const WAVERR_BADFORMAT = &H20&    '  unsupported wave format
Public Const WAVERR_STILLPLAYING = &H21& '  still something playing
Public Const WAVERR_UNPREPARED = &H22&   '  header not prepared
Public Const WAVERR_SYNC = &H23&         '  device is synchronous
Public Const WAVERR_LASTERROR = &H24&    '  last error in range

Public Const WIM_OPEN = &H3BE
Public Const WIM_CLOSE = &H3BF
Public Const WIM_DATA = &H3C0

Public Const CHAN_LEFT = &H1&
Public Const CHAN_RIGHT = &H2&
Public Const CHAN_BOTH = &H3&

Public Const MIXER_LONG_NAME_CHARS = 64
Public Const MIXER_SHORT_NAME_CHARS = 16

Public Const MIXER_GETLINEINFOF_SOURCE = &H1&
Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&

Public Const MIXER_GETLINECONTROLSF_ONEBYID = &H1&
Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&

Public Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&

Public Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&

Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Public Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)
Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)

Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Public Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)

Public Const MIXERCONTROL_CT_CLASS_METER = &H10000000
Public Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000

Public Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Public Const MIXERCONTROL_CT_UNITS_SIGNED = &H20000
Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000

Public Const MIXERCONTROL_CT_SC_METER_POLLED = &H0&
Public Const MIXERCONTROL_CONTROLTYPE_BOOLEAN =
(MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_UNITS_BOOLEAN)
Public Const MIXERCONTROL_CONTROLTYPE_MUTE =
(MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)

Public Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER
Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_VOLUME =
(MIXERCONTROL_CONTROLTYPE_FADER + 1)
Public Const MIXERCONTROL_CONTROLTYPE_SIGNEDMETER =
(MIXERCONTROL_CT_CLASS_METER Or MIXERCONTROL_CT_SC_METER_POLLED Or
MIXERCONTROL_CT_UNITS_SIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_PEAKMETER =
(MIXERCONTROL_CONTROLTYPE_SIGNEDMETER + 1)

Public Const MIXER_OBJECTF_HANDLE As Long = &H80000000
Public Const MIXER_OBJECTF_MIXER As Long = &H0&
Public Const MIXER_OBJECTF_HMIXER As Long = (MIXER_OBJECTF_HANDLE Or
MIXER_OBJECTF_MIXER)

Public Const CALLBACK_NULL = &H0           ' No callback mechanism. This is
the default setting.
Public Const CALLBACK_WINDOW = &H10000     ' window handle
Public Const CALLBACK_THREAD = &H20000     ' thread identifier.
Public Const CALLBACK_FUNCTION = &H30000   ' callback procedure address
Public Const CALLBACK_EVENT = &H50000      ' event handle.

Public Const GWL_WNDPROC = -4

Public Const MM_MIXM_LINE_CHANGE = &H3D0
Public Const MM_MIXM_CONTROL_CHANGE = &H3D1

Public Const MMIO_READ = &H0
Public Const MMIO_FINDCHUNK = &H10
Public Const MMIO_FINDRIFF = &H20
Public Const MM_WOM_DONE = &H3BD

Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_ERROR = 1
Public Const MMSYSERR_BADDEVICEID = 2
Public Const MMSYSERR_NOTENABLED = 3
Public Const MMSYSERR_ALLOCATED = 4
Public Const MMSYSERR_INVALHANDLE = 5
Public Const MMSYSERR_NODRIVER = 6
Public Const MMSYSERR_NOMEM = 7
Public Const MMSYSERR_NOTSUPPORTED = 8
Public Const MMSYSERR_BADERRNUM = 9
Public Const MMSYSERR_INVALFLAG = 10
Public Const MMSYSERR_INVALPARAM = 11
Public Const MMSYSERR_HANDLEBUSY = 12
Public Const MMSYSERR_INVALIDALIAS = 13

'MCIERR_WAVE_INPUTSINUSE All waveform devices that can record files in the
current format are in use. Wait until one of these devices is free; then,
try again.
'MCIERR_WAVE_INPUTSUNSUITABLE No installed waveform device can record files
in the current format. Use the Drivers option from the Control Panel to
install a suitable waveform recording device.
'MCIERR_WAVE_INPUTUNSPECIFIED You can specify any compatible waveform
recording device.
'MCIERR_WAVE_OUTPUTSINUSE All waveform devices that can play files in the
current format are in use. Wait until one of these devices is free; then,
try again.
'MCIERR_WAVE_OUTPUTSUNSUITABLE No installed waveform device can play files
in the current format. Use the Drivers option from the Control Panel to
install a suitable waveform device.
'MCIERR_WAVE_OUTPUTUNSPECIFIED You can specify any compatible waveform
playback device.
'MCIERR_WAVE_SETINPUTINUSE The current waveform device is in use. Wait until
the device is free; then, try again to set the device for recording.
'MCIERR_WAVE_SETINPUTUNSUITABLE The device you are using to record a
waveform cannot recognize the data format.
'MCIERR_WAVE_SETOUTPUTINUSE The current waveform device is in use. Wait
until the device is free; then, try again to set the device for playback.
'MCIERR_WAVE_SETOUTPUTUNSUITABLE The device you are using to playback a
waveform cannot recognize the data format.

Public Const LPTR = (&H0 Or &H40)

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

Type tWaveInCaps
   ManufacturerID As Integer       'wMid
   ProductID As Integer            'wPid
   DriverVersion As Long           'MMVERSIONS vDriverVersion
   ProductName(1 To 32) As Byte    'szPname[MAXPNAMELEN]
   Formats As Long
   Channels As Integer
   reserved As Integer
End Type

Type tWaveFormat
   FormatTag As Integer
   Channels As Integer
   SamplesperSec As Long
   AvgBytesPerSec As Long
   BlockAlign As Integer
   BitsPerSample As Integer
   ExtraDataSize As Integer
End Type

Type tWaveHdr
   lpData As Long
   dwBufferLength As Long
   dwBytesRecorded As Long
   dwUser As Long
   dwFlags As Long
   dwLoops As Long
   lpNext As Long 'wavehdr_tag
   reserved As Long
End Type

Type MMCKInfo
   ckid As Long
   ckSize As Long
   fccType As Long
   dwDataOffset As Long
   dwFlags As Long
End Type
Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

' types for mixer

Type MIXERCONTROL
   cbStruct As Long
   dwControlID As Long
   dwControlType As Long
   fdwControl As Long
   cMultipleItems As Long
   szShortName As String * MIXER_SHORT_NAME_CHARS
   szName As String * MIXER_LONG_NAME_CHARS
   lMinimum As Long
   lMaximum As Long
   reserved(10) As Long
End Type

Type MIXERCONTROLDETAILS
   cbStruct As Long
   dwControlID As Long
   cChannels As Long
   item As Long
   cbDetails As Long
   paDetails As Long
End Type

Type MIXERCONTROLDETAILS_UNSIGNED
   dwValue As Long
End Type

Type MIXERCONTROLDETAILS_BOOLEAN
    dwValue As Long
End Type

Type MIXERLINE
   cbStruct As Long
   dwDestination As Long
   dwSource As Long
   dwLineID As Long
   fdwLine As Long
   dwUser As Long
   dwComponentType As Long
   cChannels As Long
   cConnections As Long
   cControls As Long
   szShortName As String * MIXER_SHORT_NAME_CHARS
   szName As String * MIXER_LONG_NAME_CHARS
   dwType As Long
   dwDeviceID As Long
   wMid As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * 32
End Type

Type MIXERLINECONTROLS
   cbStruct As Long
   dwLineID As Long
   dwControl As Long
   cControls As Long
   cbmxctrl As Long
   pamxctrl As Long
End Type

Declare Function mciGetErrorString Lib "winmm.dll" Alias
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String,
ByVal uLength As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long

Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
   ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long,
_
   ByVal fdwOpen As Long) As Long

Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
   "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
   ByVal fdwInfo As Long) As Long

Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
   "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As
MIXERLINECONTROLS, _
   ByVal fdwControls As Long) As Long

Declare Function mixerGetControlDetails Lib "winmm.dll" Alias
"mixerGetControlDetailsA" _
(ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As
Long) As Long

Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
   As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Declare Function mixerMessage Lib "winmm.dll" _
              (ByVal hMx As Long, _
              ByVal uMsg As Long, _
              ByVal dwParam1 As Long, _
              ByVal dwParam2 As Long) As Long

Declare Function mixerClose Lib "winmm.dll" (ByVal hMx As Long) As Long

Declare Function waveInAddBuffer Lib "winmm" (ByVal InputDeviceHandle As
Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long
Declare Function waveInPrepareHeader Lib "winmm" (ByVal InputDeviceHandle As
Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long
Declare Function waveInUnprepareHeader Lib "winmm" (ByVal InputDeviceHandle
As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As
Long

Declare Function waveInGetNumDevs Lib "winmm" () As Long
Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA"
(ByVal uDeviceID As Long, ByVal WaveInCapsPointer As Long, ByVal
WaveInCapsStructSize As Long) As Long

Declare Function waveInOpen Lib "winmm" (WaveDeviceInputHandle As Long,
ByVal WhichDevice As Long, ByVal tWaveFormatPointer As Long, ByVal CallBack
As Long, ByVal CallBackInstance As Long, ByVal Flags As Long) As Long
Declare Function waveInClose Lib "winmm" (ByVal WaveDeviceInputHandle As
Long) As Long

Declare Function waveInStart Lib "winmm" (ByVal WaveDeviceInputHandle As
Long) As Long
Declare Function waveInReset Lib "winmm" (ByVal WaveDeviceInputHandle As
Long) As Long
Declare Function waveInStop Lib "winmm" (ByVal WaveDeviceInputHandle As
Long) As Long
Declare Function waveInGetErrorText Lib "winmm.dll" Alias
"waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal
uSize As Long) As Long

Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal
uFlags As Long) As Long
Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As
MMCKInfo, lpckParent As MMCKInfo, ByVal uFlags As Long) As Long
Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend"
(ByVal hmmio As Long, lpck As MMCKInfo, ByVal x As Long, ByVal uFlags As
Long) As Long
Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal
szFileName As String, lpmmioinfo As mmioInfo, ByVal dwOpenFlags As Long) As
Long
Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, ByVal pch As
Long, ByVal cch As Long) As Long
Declare Function mmioReadFormat Lib "winmm.dll" Alias "mmioRead" (ByVal
hmmio As Long, ByRef pch As tWaveFormat, ByVal cch As Long) As Long
Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias
"mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As
MMCKInfo, ByVal uFlags As Long) As Long

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal
dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal
uBytes As Long) As Long
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct
As Any, ByVal ptr As Long, ByVal cb As Long)
Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal
ptr As Long, struct As Any, ByVal cb As Long)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (Destination As Any, Source As Any, ByVal Length As Long)

Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Declare Function GetTickCount Lib "kernel32.dll" () As Long

Public UsrCtl As Object

Public hDev As Long
Public hMx As Long

Public wHdra As tWaveHdr
Public wHdrb As tWaveHdr
Public wHdrc As tWaveHdr

Sub Main()

End Sub

Static Function waveInProc(ByVal DevHandle As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByRef wHdr As tWaveHdr, ByVal dwParam2 As Long) As
Long

   ' waveInProc(HWAVEIN hwi,UINT uMsg, DWORD dwInstance,  DWORD dwParam1,
DWORD dwParam2)

   Dim rc As Long
   Dim msg As String

   ' msgbox ("waveinproc")

   If TypeName(UsrCtl) <> "nothing" Then

       ' msgbox ("UsrCtl defined, type=" + TypeName(UsrCtl))
       'SmplInd.Visible = True

       Select Case wMsg

           Case WIM_DATA
'               MsgBox ("data ...")
               MsgBox ("data (" + wHdr.dwBytesRecorded + " bytes)")
               UsrCtl.gotData = 1
'                rc = waveInAddBuffer(hDev, VarPtr(wHdr), Len(wHdr))
'                If rc <> 0 Then
'                    waveInGetErrorText rc, msg, Len(msg)
'                    Call MsgBox("Wave in add buffer a has failed (" +
Str(rc) + "): " + msg, vbExclamation, "Ack!")
'                End If

           Case WIM_OPEN
               UsrCtl.gotData = -1
   '            MsgBox ("open")

           Case WIM_CLOSE
               UsrCtl.gotData = -2
   '            MsgBox ("close")

           Case Else
               MsgBox ("unknown msg in callbck : " + Str(wMsg))

       End Select

       'MicSrc.SmplInd.Visible = False
   Else
           MsgBox ("UsrCtl NOT defined while in waveinproc !")
   End If

End Function

Public Function MixerChangeProc(ByVal DevHandle As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByRef hdr As tWaveHdr, ByVal dwParam2 As Long) As Long

End Function
------------------------------------

Dimitri.