Hello,
I created successfully input level meter by searching VB6 examples on
the net, but I dont know how to modify to be stereo with two
progressbar. I using waveInOpen and waveInAddBuffer API calls and as
mono meter working well.
Here is the part of my working code, please help what I have to modofy to be stereo:
-------------------------------------------------
Public Function getVolume(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
getVolume = tempval
pbuff = inHdr(0).lpData
End Function
--------------------------------------------
Public Function StartInput() As Boolean
On Error GoTo err
format.wFormatTag = 1
format.nChannels = 2
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, Form1.Combo13.ListIndex, 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
--------------------------------------------
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
-----------------------------------------
Private Sub Timer1_Timer()
If SoundMeter.getVolume(buffaddress) >= ProgressBar1(0).Max Then
ProgressBar1(0).Value = ProgressBar1(0).Max
Label6.ForeColor = &HFF&
Label6.Caption = SoundMeter.getVolume(buffaddress)
Else
ProgressBar1(0).Value = SoundMeter.getVolume(buffaddress)
Label6.ForeColor = &H80000012
Label6.Caption = SoundMeter.getVolume(buffaddress)
End If
End Sub
No one has replied yet! Why not be the first?
Sign in or Join us (it's free).