battle programmers alliance
Would you like to react to this message? Create an account in a few clicks or log in to continue.

battle programmers allianceLog in

battle programming a forum for elite programmers with extreme will power to sharpen their skills

vb.net volume meter

2 posters

descriptionvb.net volume meter Emptyvb.net volume meterTue Sep 06, 2011 2:23 am

more_horiz
Introduction
volume meter in vb.net tested working gets the audio level from usb microphone (in 2 channels)

at realtime

utilizing directx

tested on vb 2008 express edition win xp pro sp3 .net 3.5

Background
the credit goes to 2 very good programers :
1 nigel ealand, who evolved the code to work in vb 2008
2 jacob klint the original poster of the code in codeguru at the link:
http://www.codeproject.com/KB/direct...87#xx3514687xx

Using the code
form controls (designer) :
1 ComboBox name : ComboBox1
2 button name : FindButton
3 button name : StartButton
4 progressbar name : ProgressBar1 maximum : 32770
5 progressbar name : ProgressBar2 maximum : 32770

download directx 9 sdk from the link :
http://www.microsoft.com/downloads/d...displaylang=en[^]

install, restart comuter, connect usb microphone with drivers installed from its cd (auto plug n play install might not suffice)

paste source code (in the end of this text) or

sln file : http://www.esac.org.uk/VUTest.zip[^] if your lazy

project, add reference, .net, microsoft.directx.sound

disabling loader lock error (debug, exeptions, managed debuging assistants,
uncheck loader lock (thrown))
if not unchecked press debug again after exeption will have been thrown


Code:

Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Imports Microsoft.DirectX.DirectSound
Imports System.Threading
Imports System.Collections.Specialized
Public Class Sound_Card_Form
Private Sub StartButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles FindButton.Click
'Dim MyVU As New VolumeMeter
'MyVU.Start()
Start()
End Sub
Private Sub FindButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles FindButton.Click
'Dim MyVU As New VolumeMeter
'MyVU.FindDevices()
FindDevices()
End Sub

' Public Class VolumeMeter
'Inherits System.Windows.Forms.UserControl
'Public Delegate Sub VolumeChangedEventHandler(ByVal vcea As VolumeChangedEventArgs)
'Public Event VolumeChanged As VolumeChangedEventHandler
Private Const SAMPLES As Integer = 8
Private Shared SAMPLE_FORMAT_ARRAY As Integer() = {SAMPLES, 2, 1}
Public Shared audioDevices As CaptureDevicesCollection
Private Shared m_deviceNames As StringCollection
Private deviceName As String = "(none)"
Private deviceIndex As Integer = -1
Private buffer As Microsoft.DirectX.DirectSound.CaptureBuffer
Private liveVolumeThread As System.Threading.Thread
Private m_sampleDelay As Integer = 100
Private m_frameDelay As Integer = 10
Private m_autoStart As Boolean = True
'Private components As System.ComponentModel.Container = Nothing
Public Sub FindDevices()
Dim audioDevices As New CaptureDevicesCollection
Dim x As Integer = 0
While x < audioDevices.Count
ComboBox1.Items.Add(audioDevices.Item(x).Description)
x = x + 1
End While
ComboBox1.SelectedIndex = 0
End Sub
Public Sub Start()
[Stop]()
Dim audioDevices As New CaptureDevicesCollection
deviceIndex = ComboBox1.SelectedIndex
If deviceIndex <> -1 Then
' initialize the capture buffer and start the animation thread
Dim cap As New Capture(audioDevices(deviceIndex).DriverGuid)
Dim desc As New CaptureBufferDescription()
Dim wf As New WaveFormat()
wf.BitsPerSample = 16
wf.SamplesPerSecond = 44100
wf.Channels = 2
wf.BlockAlign = CShort(wf.Channels * wf.BitsPerSample / 8)
wf.AverageBytesPerSecond = wf.BlockAlign * wf.SamplesPerSecond
wf.FormatTag = WaveFormatTag.Pcm
desc.Format = wf
desc.BufferBytes = SAMPLES * wf.BlockAlign
buffer = New Microsoft.DirectX.DirectSound.CaptureBuffer(desc, cap)
buffer.Start(True)
' Start a seperate thread to read the buffer and update the progress bars
liveVolumeThread = New Thread(AddressOf updateProgress) 'Thread starts at updateProgress
Control.CheckForIllegalCrossThreadCalls = False ' This is needed otherwise the form will not update
liveVolumeThread.Priority = ThreadPriority.Lowest ' Thread works in the background
liveVolumeThread.Start()
End If
End Sub
Public Sub [Stop]()
If liveVolumeThread IsNot Nothing Then
liveVolumeThread.Abort()
liveVolumeThread.Join()
liveVolumeThread = Nothing
End If
If buffer IsNot Nothing Then
If buffer.Capturing Then
buffer.[Stop]()
End If
buffer.Dispose()
buffer = Nothing
End If
End Sub

Public Sub updateProgress()
While True
Dim tempFrameDelay As Integer = m_frameDelay
Dim tempSampleDelay As Integer = m_sampleDelay
Dim samples__1 As Array = buffer.Read(0, GetType(Int16), LockFlag.FromWriteCursor, SAMPLE_FORMAT_ARRAY)
' for each channel, determine the step size necessary for each iteration
Dim leftGoal As Integer = 0
Dim rightGoal As Integer = 0
' Sum the 8 samples
For i As Integer = 0 To SAMPLES - 1
leftGoal += CType(samples__1.GetValue(i, 0, 0), Int16)
rightGoal += CType(samples__1.GetValue(i, 1, 0), Int16)
Next
' Calculate the average of the 8 samples
leftGoal = CInt(Math.Abs(leftGoal \ SAMPLES))
rightGoal = CInt(Math.Abs(rightGoal \ SAMPLES))
Dim range1 As Double = leftGoal - ProgressBar1.Value ' calculates the difference between new and the current progress bar value
Dim range2 As Double = rightGoal - ProgressBar2.Value
' Assign the exact current value to the progress bar
Dim exactValue1 As Double = ProgressBar1.Value
Dim exactValue2 As Double = ProgressBar2.Value
Dim stepSize1 As Double = range1 / tempSampleDelay * tempFrameDelay
' Limit the value range to positive values
If Math.Abs(stepSize1) < 0.01 Then
stepSize1 = Math.Sign(range1) * 0.01
End If
Dim absStepSize1 As Double = Math.Abs(stepSize1)
Dim stepSize2 As Double = range2 / tempSampleDelay * tempFrameDelay
If Math.Abs(stepSize2) < 0.01 Then
stepSize2 = Math.Sign(range2) * 0.01
End If
Dim absStepSize2 As Double = Math.Abs(stepSize2)
' increment/decrement the bars' values until both equal their desired goals,
' sleeping between iterations
If (ProgressBar1.Value = leftGoal) AndAlso (ProgressBar2.Value = rightGoal) Then
Thread.Sleep(tempSampleDelay)
Else
Do
If ProgressBar1.Value <> leftGoal Then
If absStepSize1 < Math.Abs(leftGoal - ProgressBar1.Value) Then
exactValue1 += stepSize1
ProgressBar1.Value = CInt(Math.Truncate(Math.Round(exactValue1)))
'This is the real value
'decibels = 20 * Log10(ProgressBar1.Value/ 32768.0)
Else
ProgressBar1.Value = leftGoal
End If
End If
If ProgressBar2.Value <> rightGoal Then
If absStepSize2 < Math.Abs(rightGoal - ProgressBar2.Value) Then
exactValue2 += stepSize2
ProgressBar2.Value = CInt(Math.Truncate(Math.Round(exactValue2)))
Else
ProgressBar2.Value = rightGoal
End If
End If
Thread.Sleep(tempFrameDelay)
Loop While (ProgressBar1.Value <> leftGoal) OrElse (ProgressBar2.Value <> rightGoal)
End If
End While
End Sub

End Class


run : press button 1 , press button 2

Points of Interest
samples delay variables (in source code) :
Private m_sampleDelay As Integer = 15 ' miliseconds
Private m_frameDelay As Integer = 15

look up in youtube: vb.net volume meter

'end of tutorial

you can delete :
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms

microphones cd drivers need to be installed.

take your time, this king of thing requires lazyness.

descriptionvb.net volume meter Emptynew vb.net volume meter 2012Sun Feb 05, 2012 1:25 am

more_horiz
vote the volume meter suggestion up :


http://visualstudio.uservoice.com/forums/121579-visual-studio/suggestions/2558281-activex-control-for-webcam-microphone

vb.net volume meter Grey%5E_%5Earial%5E_%5E7%5E_%5E0%5E_%5Eyes YES !%5E_%5E

descriptionvb.net volume meter Emptyvb.net 2012 volume meterSun Jul 01, 2012 12:07 pm

more_horiz
BATTLE PROGRAMMING OVERLORD MODE has been enabled

BPA VOLUME METER WALKTHROUGH :

activation :

start a 3rd party volume meter (like in webcam accompanied software)
start the visual basic application ( see code below )
place mouse on 3rd party volume meter start area : mouse_______
tab and enter coordinates with x1y1Btn
place mouse on 3rd party volume meter end area : ______mouse
tab and enter coordinates with x2Btn
click done btn

the application assumes the 3rd party volume meter is on a progress bar with white
backround and shows increased volume levels left to right for other the programmer
will have to modify the code.


source code :

Code:

Public Class Form1
    Dim x1, y1, x2, dist As Integer
    Dim bm As Bitmap
    Sub RGB_breakerBuster(ByVal inColor As Color, ByRef red As Integer, ByRef green As Integer, ByRef blue As Integer)
        ' returns value of red,green,blue in a pixel of a bitmap as integers
        red = inColor.R
        green = inColor.G
        blue = inColor.B
    End Sub
    Public Function getPixelColor(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As Char
        ' r= red, g = green, b = blue
        Dim colorchar As Char
        If r > 245 And g > 245 And b > 245 Then
            colorchar = "w" ' white
        ElseIf r < 20 And g < 20 And b < 20 Then
            colorchar = "k" ' black (kuro in japanese)
        ElseIf r > g And g > b And g < 100 Then
            colorchar = "r" ' red
        ElseIf r > g And g > b And g > 200 Then
            colorchar = "y" ' yellow
        ElseIf r > g And g > b And 100 < g < 200 Then
            colorchar = "o" 'orange
        ElseIf (g > r And r > b) Or (g > b And b > r) Then
            colorchar = "g" 'green
        ElseIf b > g And g > r Then
            colorchar = "b" 'blue
        ElseIf (b > r And r > g) Or (r > b And g < 20) Then
            colorchar = "v" ' violet
        Else
            colorchar = "u" ' yet undefined
        End If
        Return colorchar
    End Function

    Private Sub x1y1Btn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles x1y1Btn.Click
        x1 = Cursor.Position.X
        y1 = Cursor.Position.Y
        TextBox1.Text = x1 & " " & y1
    End Sub

    Private Sub x2Btn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles x2Btn.Click
        x2 = Cursor.Position.X
        TextBox2.Text = x2
        dist = x2 - x1
    End Sub

    Private Sub doneBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles doneBtn.Click
        If doneBtn.Text = "done" Then
            Timer1.Enabled = True
            doneBtn.Text = "reset"
        Else
            Timer1.Enabled = False
            doneBtn.Text = "done"
            x1 = 0
            y1 = 0
            x2 = 0
            TextBox1.Text = ""
            TextBox2.Text = ""
            ProgressBar1.Value = 0
        End If
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        ' get image
        Dim screenBounds = Screen.PrimaryScreen.Bounds
        Dim screenShot As New Bitmap(screenBounds.Width, screenBounds.Height)
        Using g = Graphics.FromImage(screenShot)
            g.CopyFromScreen(screenBounds.Location, Point.Empty, screenBounds.Size)
        End Using
        bm = screenShot
        PictureBox1.Image = bm
        ' end of image capture
        Dim r, g1, b As Integer
        Dim sum As Byte = 0
        For index = 0 To 4
            RGB_breakerBuster(bm.GetPixel(x1 + (dist * index) \ 5, y1), r, g1, b)
            If getPixelColor(r, g1, b) = "w" Then
                sum += 1
            End If
        Next
        ProgressBar1.Value = sum * 20
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        x1 = 0
        y1 = 0
        x2 = 0
        ProgressBar1.Value = 0
    End Sub
End Class

_________________
MB over and out emp it up

descriptionvb.net volume meter EmptyRe: vb.net volume meterThu Mar 16, 2017 9:45 pm

more_horiz
solved by digitalshaman

Code:

Public Class Form1
    'needs: a listview called ListView1
    '      two buttons, one called btnStart, the other btnStop
    '      a PictureBox called PictureBox1

    Private WithEvents oWaveIn As New WaveIn
    'Private oStream As IO.FileStream

    Private maxAmplitude As Int32

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        'get the list of input devices and display in listview
        Dim s() As String = oWaveIn.GetDeviceNames()
        s.ToList.ForEach(Sub(sName)
                            ListView1.Items.Add(sName)
                        End Sub)
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If ListView1.SelectedItems.Count = 0 OrElse ListView1.SelectedItems.Count > 1 Then
            MessageBox.Show("Select one Device")
            Exit Sub
        End If

        'set the desired recording format to 44.1kHz, 16Bit Stereo
        oWaveIn.SetFormat(44100, 16, 2)

        Dim iDevice As Int32 = ListView1.SelectedItems(0).Index
        oWaveIn.Prepare(iDevice, 60, 4410)    '60 x 4410 Bytes=2205 16 bit samples = 50ms @44100 * 60 = 3 seconds audio

        'LameMp3Convert.InitLame()
        'oStream = New IO.FileStream("c:\kill\recording.mp3", IO.FileMode.Create)


        oWaveIn.StartRecording()

        Button1.Enabled = False
        Button2.Enabled = True
    End Sub

    Private Sub o_BufferFull(Index As Integer) Handles oWaveIn.BufferFilled
        'Label1.Invoke(Sub()
        '                  Label1.Text = Index.ToString
        '              End Sub)
        Dim bt As Byte() = oWaveIn.GetData()
        'Dim btEncoded As Byte() = LameMp3Convert.EncodeBlock(bt, bt.Length)
        'oStream.Write(btEncoded, 0, btEncoded.Length)

        'get the max amplitude from the data
        maxAmplitude = 0
        For i As Int32 = 0 To bt.Length - 1 Step 2
            Dim val As Int16 = Convert.ToInt16(bt(i + 1)) << 8 Or bt(i)
            If Math.Abs(CInt(val)) > maxAmplitude Then
                maxAmplitude = Math.Abs(CInt(val))
            End If
        Next
        PictureBox1.Invalidate()
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        oWaveIn.StopRecording()
        oWaveIn.Unprepare()
        'oStream.Close()

        Button2.Enabled = False
        Button1.Enabled = True
    End Sub

    Private Sub oWaveIn_Overflow() Handles oWaveIn.Overflow
        Me.Invoke(Sub()
                      Me.BackColor = Color.Red
                  End Sub)
    End Sub

    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
        Dim db As Double = -4.5198 / (20 * Math.Log10(maxAmplitude / (Int16.MaxValue + 1)))
        db = If(Double.IsInfinity(db), 1, db)
        e.Graphics.FillRectangle(Brushes.Gray, New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height))
        e.Graphics.FillRectangle(Brushes.LawnGreen, New Rectangle(0, 0, CInt(PictureBox1.Width * db), PictureBox1.Height))
    End Sub

End Class


right click solution, add class :

Code:

Imports System.Runtime.InteropServices

Public Class WaveIn
#Region "API"

    Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" _
        (ByVal Err As Int32, ByVal Text As String, ByVal uSize As Int32) As Int32
    Private Const MAXERRORLENGTH As Int32 = 128

    Private Declare Function waveInGetNumDevs Lib "winmm" () As Int32

    Private Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA" (
            ByVal uDeviceID As Int32, ByRef WaveInCapsPointer As WAVEINCAPS,
            ByVal WaveInCapsStructSize As Int32) As Int32


    Private Declare Function waveInOpen Lib "winmm" (ByRef phwi As IntPtr, ByVal uDeviceID As Int32,
            ByRef pwfx As WAVEFORMATEX, ByVal CallBack As waveInProc, ByVal CallBackInstance As Int32,
            ByVal fdwOpen As Int32) As Int32

    Private Delegate Sub waveInProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As IntPtr,
                                    ByVal dwParam1 As IntPtr, ByVal dwParam2 As IntPtr)
    Private procWaveIn As waveInProc

    Private Declare Function waveInClose Lib "winmm" (ByVal hwi As IntPtr) As Int32

    Private Declare Function waveInStart Lib "winmm" (ByVal hwi As IntPtr) As Int32

    Private Declare Function waveInReset Lib "winmm" (ByVal WaveDeviceInputHandle As IntPtr) As IntPtr

    Private Declare Function waveInStop Lib "winmm" (ByVal WaveDeviceInputHandle As IntPtr) As IntPtr

    Private Declare Function waveInAddBuffer Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
            ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32

    Private Declare Function waveInPrepareHeader Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
            ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32

    Private Declare Function waveInUnprepareHeader Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
            ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32


    'header eines Aufnahme Buffers:
    <StructLayout(LayoutKind.Sequential)>
    Private Structure WAVEHDR
        Public lpData As IntPtr
        Public dwBufferLength As Int32
        Public dwBytesRecorded As Int32
        Public dwUser As Int32
        Public dwFlags As Int32
        Public dwLoops As Int32
        Public lpNext As IntPtr
        Public Reserved As Int32
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Private Structure WAVEINCAPS
        Public ManufacturerID As Int16
        Public ProductID As Int16
        Public DriverVersion As Int32
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> Public ProductName As Char()
        Public Formats As Int32
        Public CHANNELS As Int16
        Public Reserved As Int16
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Private Structure WAVEFORMATEX
        Public wFormatTag As Int16
        Public nChannels As Int16
        Public nSamplesPerSec As Int32
        Public nAvgBytesPerSec As Int32
        Public nBlockAlign As Int16
        Public wBitsPerSample As Int16
        Public cbSize As Int16
    End Structure

    Private Const CALLBACK_FUNCTION As Int32 = &H30000
    Private Const CALLBACK_WINDOW As Int32 = &H10000


    Private Const MM_WIM_CLOSE As Int32 = &H3BF
    Private Const MM_WIM_DATA As Int32 = &H3C0
    Private Const MM_WIM_OPEN As Int32 = &H3BE
    Private Const WIM_OPEN As Int32 = MM_WIM_OPEN
    Private Const WIM_DATA As Int32 = MM_WIM_DATA
    Private Const WIM_CLOSE As Int32 = MM_WIM_CLOSE

    Private Const WAVE_FORMAT_PCM As Int32 = &H1

#End Region

    Event BufferFilled(Index As Int32)
    Event Overflow()


    Public isOverflow As Boolean 'indicates loss of data due to insufficient free buffers

    Private udtRecordingFormat As WAVEFORMATEX

    Private iWriteIndex As Int32    'index of the next buffer to be filled by the device
    Private lReadIndex As Int32    'index of the filled next buffer to be read by the client
    Private cBuffers As Int32      'number of buffers
    Private cbBuffer As Int32      'size in bytes of one buffer
    Private cFullBuffers As Int32  'number of filled buffers that have not yet been processed by the client

    Private cbBufferHeader As Int32  'SizeOf(WAVEHDR)
    Private lpBufferHeaders As IntPtr 'pointer to the heap memory storing the buffer headers. Size: cBuffers * cbBufferHeader (all in one block)
    Private lpBufferData As IntPtr    'pointer to the heap memory storing the buffers. Size: cBuffers * cbBuffer (all in one block)

    Private isRecording As Boolean

    Private hOpenDevice As IntPtr 'Handle of the Audiodevice

    Private WatcherThread As Threading.Thread


    Public Sub New()
        SetFormat(44100, 16, 2)  'default
    End Sub


    ReadOnly Property Recording As Boolean
        Get
            Return isRecording
        End Get
    End Property

    Public Function GetDeviceNames() As String()
        Dim sDevices(0 To waveInGetNumDevs - 1) As String
        Dim WavCaps As New WAVEINCAPS

        For i As Int32 = 0 To sDevices.Count - 1
            waveInGetDevCaps(i, WavCaps, Marshal.SizeOf(WavCaps))
            Dim sTemp As New String(WavCaps.ProductName)
            sDevices(i) = sTemp.Substring(0, sTemp.IndexOf(Convert.ToChar(0)))
        Next
        Return sDevices
    End Function

    Public Sub SetFormat(SamplesPerSec As Int32, BitsPerSample As Int16, CHANNELS As Int16)
        With udtRecordingFormat
            .cbSize = 0
            .nChannels = CHANNELS
            .nSamplesPerSec = SamplesPerSec
            .wBitsPerSample = BitsPerSample
            .nBlockAlign = Convert.ToInt16(BitsPerSample / 8 * CHANNELS)
            .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
            .wFormatTag = WAVE_FORMAT_PCM
        End With
    End Sub

    Public Function Prepare(DeviceID As Int32, BufferCount As Int32, BufferSize As Int32) As Boolean
        'Open device and add audio buffers

        Unprepare() 'just in case

        cBuffers = BufferCount
        cbBuffer = BufferSize

        Dim dwApiResult As Int32
        procWaveIn = AddressOf MyWaveInProc
        dwApiResult = waveInOpen(hOpenDevice, DeviceID, udtRecordingFormat, procWaveIn, 0, CALLBACK_FUNCTION)

        If Not dwApiResult = 0 Then
            Unprepare()
            Throw New Exception(FormatWaveError(dwApiResult))
        End If

        'prepare buffers and pass them to the device:
        Dim udt As New WAVEHDR With {.dwBufferLength = cbBuffer, .dwFlags = 0}
        cbBufferHeader = Marshal.SizeOf(udt)
        lpBufferHeaders = Marshal.AllocHGlobal(cbBufferHeader * cBuffers)
        lpBufferData = Marshal.AllocHGlobal(cbBuffer * cBuffers)

        dwApiResult = 0
        For i As Int32 = 0 To cBuffers - 1
            udt.dwUser = i            'buffer index in dwUser
            udt.lpData = lpBufferData + i * cbBuffer
            Marshal.StructureToPtr(udt, lpBufferHeaders + i * cbBufferHeader, False)
            dwApiResult = dwApiResult Or waveInPrepareHeader(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
            dwApiResult = dwApiResult Or waveInAddBuffer(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
        Next

        If dwApiResult <> 0 Then
            Unprepare()  'there was an issue preparing the buffers
            Throw New Exception("waveInPrepareHeader/waveInAddBuffer Error!")
        End If
        isOverflow = False
        cFullBuffers = 0
        Return (dwApiResult = 0)
    End Function

    Public Function StartRecording() As Boolean
        WatcherThread = New Threading.Thread(AddressOf Watcher)
        WatcherThread.Start()
        isRecording = (waveInStart(hOpenDevice) = 0)
        Return isRecording
    End Function

    Public Function GetData() As Byte()
        'returns a copy of the recorded data. if multiple buffers are completed,
        'it returns the entire data of all finished buffers.
        'the processed buffers are added back to the device
        Dim cFullBuffersTemp As Int32
        Dim cbUsedUpper As Int32
        Dim cbUsedLower As Int32
        Dim btData(0) As Byte

        Dim udt As WAVEHDR

        If cFullBuffers > 0 Then
            cFullBuffersTemp = cFullBuffers 'cFullBuffers may change during execution
            'sum the length of all finished buffers
            For i As Int32 = 0 To cFullBuffersTemp - 1
                udt = DirectCast(Marshal.PtrToStructure(lpBufferHeaders + (lReadIndex + i) * cbBufferHeader, GetType(WAVEHDR)), WAVEHDR)
                If lReadIndex + i < cBuffers Then
                    cbUsedUpper += udt.dwBytesRecorded
                Else
                    cbUsedLower += udt.dwBytesRecorded
                End If
            Next
            ReDim btData(cbUsedLower + cbUsedUpper - 1)

            'copy the data
            If cbUsedLower > 0 Then
                'two blocks
                Marshal.Copy(lpBufferData, btData, cbUsedUpper, cbUsedLower)
            End If
            udt = DirectCast(Marshal.PtrToStructure(lpBufferHeaders + lReadIndex * cbBufferHeader, GetType(WAVEHDR)), WAVEHDR)
            Marshal.Copy(udt.lpData, btData, 0, cbUsedUpper)

            'add buffers back to the device
            Do While cFullBuffersTemp > 0
                DoneBuffer()
                cFullBuffersTemp -= 1
            Loop
        End If
        Return btData
    End Function

    Private Sub DoneBuffer()
        'adds the buffer iReadIndex back to the device buffer chain
        If cFullBuffers > 0 Then
            cFullBuffers -= 1
            Dim dwApiResult As Int32 = waveInAddBuffer(hOpenDevice, lpBufferHeaders + lReadIndex * cbBufferHeader, cbBufferHeader)
            If dwApiResult <> 0 Then
                Throw New Exception("WaveInDoneBuffer waveInAddBuffer Error: " & FormatWaveError(dwApiResult))
            End If

            lReadIndex += 1
            If lReadIndex = cBuffers Then
                lReadIndex = 0
            End If
        End If
    End Sub

    Public Sub StopRecording()
        If Not hOpenDevice.Equals(IntPtr.Zero) Then
            waveInStop(hOpenDevice)
            waveInReset(hOpenDevice)
            isOverflow = False
        End If
        If WatcherThread IsNot Nothing Then
            WatcherThread.Abort()
            WatcherThread = Nothing
        End If
        isRecording = False
    End Sub

    Public Sub Unprepare()
        StopRecording()
        If Not hOpenDevice.Equals(IntPtr.Zero) Then
            For i As Int32 = 0 To cBuffers - 1
                waveInUnprepareHeader(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
            Next

            Marshal.FreeHGlobal(lpBufferData)
            Marshal.FreeHGlobal(lpBufferHeaders)

            If waveInClose(hOpenDevice) = 0 Then
                hOpenDevice = Nothing
            Else
                Throw New Exception("Error closing the device!")
            End If
        End If
        iWriteIndex = 0
        lReadIndex = 0
    End Sub


    Private Sub MyWaveInProc(hDevice As Int32, uMsg As UInt32, dwInstance As IntPtr, dwParam1 As IntPtr, dwParam2 As IntPtr)
        'Low Level Wave In Proc
        'MSDN: "Applications should not call any system-defined functions from inside a callback function" so keep it simple
        Select Case uMsg
            Case WIM_OPEN

            Case WIM_CLOSE

            Case WIM_DATA
                cFullBuffers += 1
                iWriteIndex += 1
                If iWriteIndex = cBuffers Then
                    iWriteIndex = 0
                End If
                If iWriteIndex = lReadIndex Then
                    isOverflow = True
                End If
        End Select
    End Sub

    Private Sub Watcher()
        Do
            If cFullBuffers > 0 Then
                RaiseEvent BufferFilled(iWriteIndex)
            End If
            If isOverflow Then
                RaiseEvent Overflow()
            End If
            Threading.Thread.Sleep(10)
        Loop
    End Sub

    Private Function FormatWaveError(ErrCode As Int32) As String
        Dim sTemp As New String(" "c, MAXERRORLENGTH)
        waveInGetErrorText(ErrCode, sTemp, MAXERRORLENGTH)
        Return sTemp.Substring(0, sTemp.IndexOf(Convert.ToChar(0)))
    End Function

End Class


it should work just copy paste+adding the required controls to the form. you need to have a workin input device, all available devices are listed in the listview. if the listview is empty for you, the api did not find an input device. to run, you select one of the inputdevices from the listview and click the start button (oh, sorry i see in my code they are called button1 and button2, not btnStart and stop as i wrote in the form comments...). you must click the stop button before closing the form otherwise things are not cleaned up correctly.

farao

_________________
MB over and out emp it up
privacy_tip Permissions in this forum:
You cannot reply to topics in this forum