Stereo input level meter (I have working mono)

vba Hungary
  • 12 years ago
    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














































































































Post a reply

No one has replied yet! Why not be the first?

Sign in or Join us (it's free).

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live.” - Rick Osborne