SpiroChronis
Programmer
I need to monitor the speaker and mic output and input respectively and draw it onto a VU meter. I have some code to check the mic level, however i can't work out how to check the speaker level. I need to do it without using the peakmeter API, as many sound cards don't support this. Can anyone help me check the speaker level?
here is the code module to check the mic level:
Dim rc As Long ' return code
Dim ok As Boolean ' boolean return code
Dim volume As Long ' volume value
Dim volHmem As Long ' handle to volume memory
Dim audbytearray As AUDINPUTARRAY
Dim audByteHigh As AUDINPUTARRAY
Dim posval As Integer
Dim tempval As Integer
Private Const CALLBACK_FUNCTION = &H30000
Private Const MM_WIM_DATA = &H3C0
Private Const WHDR_DONE = &H1 ' done bit
Private Const GMEM_FIXED = &H0 ' Global Memory Flag used by GlobalAlloc functin
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
Type WAVEINCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * 32
dwFormats As Long
wChannels As Integer
End Type
Type WAVEFORMAT
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
End Type
Type AUDINPUTARRAY
bytes(5000) As Byte
End Type
Private Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInReset Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long
Private Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private i As Integer, j As Integer, msg As String * 200, hWavein As Long
Private Const NUM_BUFFERS = 2
Private format As WAVEFORMAT, hmem(NUM_BUFFERS) As Long, inHdr(NUM_BUFFERS) As WAVEHDR
Public BUFFER_SIZE
Private Const DEVICEID = 0
Private fRecording As Boolean
'Check the output of the mic
Private Sub waveInProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)
If (uMsg = MM_WIM_DATA) Then
If fRecording Then
rc = waveInAddBuffer(hwi, hdr, Len(hdr))
End If
End If
End Sub
Public Function StartInput() As Boolean
On Error GoTo err
format.wFormatTag = 1
format.nChannels = 1
format.wBitsPerSample = 8
format.nSamplesPerSec = 8000
format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
format.nAvgBytesPerSec = format.nSamplesPerSec * format.nBlockAlign
format.cbSize = 0
For i = 0 To NUM_BUFFERS - 1
hmem(i) = GlobalAlloc(&H40, BUFFER_SIZE)
inHdr(i).lpData = GlobalLock(hmem(i))
inHdr(i).dwBufferLength = BUFFER_SIZE
inHdr(i).dwFlags = 0
inHdr(i).dwLoops = 0
Next
rc = waveInOpen(hWavein, DEVICEID, format, 0, 0, 0)
If rc <> 0 Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
StartInput = False
Exit Function
End If
For i = 0 To NUM_BUFFERS - 1
rc = waveInPrepareHeader(hWavein, inHdr(i), Len(inHdr(i)))
If (rc <> 0) Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
End If
Next
For i = 0 To NUM_BUFFERS - 1
rc = waveInAddBuffer(hWavein, inHdr(i), Len(inHdr(i)))
If (rc <> 0) Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
End If
Next
fRecording = True
rc = waveInStart(hWavein)
StartInput = True
Exit Function
err:
StartInput = False
End Function
Public Function StopInput() As Integer
On Error GoTo err
fRecording = False
waveInReset hWavein
waveInStop hWavein
For i = 0 To NUM_BUFFERS - 1
waveInUnprepareHeader hWavein, inHdr(i), Len(inHdr(i))
GlobalFree hmem(i)
Next
waveInClose hWavein
GlobalFree volHmem
StopInput = 0
Exit Function
err:
StopInput = 1
End Function
Public Function getMicVolume(pbuff As Long) As Integer
Dim n As Integer
On Error Resume Next
Do While Not inHdr(0).dwFlags And WHDR_DONE
' perhaps I ought to put a time limit on this bit!
Loop
iValue.Caption = CStr(0)
iValue.Refresh
CopyStructFromPtr audbytearray, inHdr(0).lpData, inHdr(0).dwBufferLength
rc = waveInAddBuffer(hWavein, inHdr(0), Len(inHdr(0)))
tempval = 0
posval = 0
For n = 0 To BUFFER_SIZE - 1
posval = audbytearray.bytes
- 128
If posval < 0 Then posval = 0 - posval
If posval > tempval Then tempval = posval
Next n
getMicVolume = tempval
pbuff = inHdr(0).lpData
End Function
here is the code module to check the mic level:
Dim rc As Long ' return code
Dim ok As Boolean ' boolean return code
Dim volume As Long ' volume value
Dim volHmem As Long ' handle to volume memory
Dim audbytearray As AUDINPUTARRAY
Dim audByteHigh As AUDINPUTARRAY
Dim posval As Integer
Dim tempval As Integer
Private Const CALLBACK_FUNCTION = &H30000
Private Const MM_WIM_DATA = &H3C0
Private Const WHDR_DONE = &H1 ' done bit
Private Const GMEM_FIXED = &H0 ' Global Memory Flag used by GlobalAlloc functin
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
Type WAVEINCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * 32
dwFormats As Long
wChannels As Integer
End Type
Type WAVEFORMAT
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
End Type
Type AUDINPUTARRAY
bytes(5000) As Byte
End Type
Private Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInReset Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWavein As Long) As Long
Private Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long
Private Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWavein As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private i As Integer, j As Integer, msg As String * 200, hWavein As Long
Private Const NUM_BUFFERS = 2
Private format As WAVEFORMAT, hmem(NUM_BUFFERS) As Long, inHdr(NUM_BUFFERS) As WAVEHDR
Public BUFFER_SIZE
Private Const DEVICEID = 0
Private fRecording As Boolean
'Check the output of the mic
Private Sub waveInProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)
If (uMsg = MM_WIM_DATA) Then
If fRecording Then
rc = waveInAddBuffer(hwi, hdr, Len(hdr))
End If
End If
End Sub
Public Function StartInput() As Boolean
On Error GoTo err
format.wFormatTag = 1
format.nChannels = 1
format.wBitsPerSample = 8
format.nSamplesPerSec = 8000
format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
format.nAvgBytesPerSec = format.nSamplesPerSec * format.nBlockAlign
format.cbSize = 0
For i = 0 To NUM_BUFFERS - 1
hmem(i) = GlobalAlloc(&H40, BUFFER_SIZE)
inHdr(i).lpData = GlobalLock(hmem(i))
inHdr(i).dwBufferLength = BUFFER_SIZE
inHdr(i).dwFlags = 0
inHdr(i).dwLoops = 0
Next
rc = waveInOpen(hWavein, DEVICEID, format, 0, 0, 0)
If rc <> 0 Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
StartInput = False
Exit Function
End If
For i = 0 To NUM_BUFFERS - 1
rc = waveInPrepareHeader(hWavein, inHdr(i), Len(inHdr(i)))
If (rc <> 0) Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
End If
Next
For i = 0 To NUM_BUFFERS - 1
rc = waveInAddBuffer(hWavein, inHdr(i), Len(inHdr(i)))
If (rc <> 0) Then
waveInGetErrorText rc, msg, Len(msg)
MsgBox msg
End If
Next
fRecording = True
rc = waveInStart(hWavein)
StartInput = True
Exit Function
err:
StartInput = False
End Function
Public Function StopInput() As Integer
On Error GoTo err
fRecording = False
waveInReset hWavein
waveInStop hWavein
For i = 0 To NUM_BUFFERS - 1
waveInUnprepareHeader hWavein, inHdr(i), Len(inHdr(i))
GlobalFree hmem(i)
Next
waveInClose hWavein
GlobalFree volHmem
StopInput = 0
Exit Function
err:
StopInput = 1
End Function
Public Function getMicVolume(pbuff As Long) As Integer
Dim n As Integer
On Error Resume Next
Do While Not inHdr(0).dwFlags And WHDR_DONE
' perhaps I ought to put a time limit on this bit!
Loop
iValue.Caption = CStr(0)
iValue.Refresh
CopyStructFromPtr audbytearray, inHdr(0).lpData, inHdr(0).dwBufferLength
rc = waveInAddBuffer(hWavein, inHdr(0), Len(inHdr(0)))
tempval = 0
posval = 0
For n = 0 To BUFFER_SIZE - 1
posval = audbytearray.bytes
If posval < 0 Then posval = 0 - posval
If posval > tempval Then tempval = posval
Next n
getMicVolume = tempval
pbuff = inHdr(0).lpData
End Function