Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Speaker Volume meter

Status
Not open for further replies.

SpiroChronis

Programmer
Mar 30, 2005
10
ZA
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(n) - 128
If posval < 0 Then posval = 0 - posval
If posval > tempval Then tempval = posval
Next n
getMicVolume = tempval
pbuff = inHdr(0).lpData
End Function
 
As far as I know you cant.
The "speaker level" is set by the knob on the amplifier of your speaker system if it has one and is naturally independent of the input levels.
The VU level shown by your code would be the level applicable for recording and as such will not give a playback reading.
Is that what you really want to do?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top