Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- From: "Catherine Borbās" <kathbor@xxxxxxxxxxx>
- Date: Wed, 18 Jul 2007 19:03:19 +0200
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.
"Thorsten Albers" <albersRE@xxxxxxxxxxxxxxxxxxx> a écrit dans le message de
news: 01c7c959$34535fa0$6401a8c0@xxxxxx
Dimitri Pochet <dpochet@xxxxxxxxxxx> schrieb im Beitrag
<uT7s#aVyHHA.5380@xxxxxxxxxxxxxxxxxxxx>...
I'm (still) using VB5; and try to manage wavein device from aself-created
VB user control.and
User control's initialize event does the Wavein open, prepare buffers,
initial add buffer; the user control's terminate event does the reset,the
stop and the close. Waveinopen declares a CALLBACK_FUNCTION which is (VBtrigger
constraint it seems), in a standard module.
When opening and closing the wavein device, WIM_OPEN and WIM_CLOSE
correctly. But WIM_DATA does never trigger.the
More : when inside the callback function I just -reference- the 4th
parameter of the callback (the wHdr), then VB or the .exe, crash after
open.
Post code (including declarations of functions and constants).
--
----------------------------------------------------------------------
THORSTEN ALBERS Universität Freiburg
albers@
uni-freiburg.de
----------------------------------------------------------------------
.
- Follow-Ups:
- Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- From: Thorsten Albers
- Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- References:
- VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- From: Dimitri Pochet
- Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- From: Thorsten Albers
- VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- Prev by Date: Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- Next by Date: Strange DC handling difference with VB apps in 9x/XP
- Previous by thread: Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- Next by thread: Re: VB5, User control for Wavein mgt, no callback call for WIM_DATA ?
- Index(es):
Relevant Pages
|
