Stereo input level meter (I have working mono)

• • Reply

  14 years ago

  by StratoFan

  Leslie Perjes

  , Hungary

  Joined 14 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
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  Report abuse