| | vb.net volume meter | |
| Author | Message |
---|
Admin Admin


Posts : 140 Join date : 2011-08-01
 | Subject: vb.net volume meter Tue Sep 06, 2011 2:23 am | |
| 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. | |
|  | | Moti Barski super


Posts : 496 Join date : 2011-08-02
 | Subject: new vb.net volume meter 2012 Sun Feb 05, 2012 1:25 am | |
| | |
|  | | Moti Barski super


Posts : 496 Join date : 2011-08-02
 | Subject: vb.net 2012 volume meter Sun Jul 01, 2012 12:07 pm | |
| 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  | |
|  | | Moti Barski super


Posts : 496 Join date : 2011-08-02
 | Subject: Re: vb.net volume meter Thu Mar 16, 2017 9:45 pm | |
| 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. _________________ MB over and out  | |
|  | | | vb.net volume meter | |
|
| Permissions in this forum: | You cannot reply to topics in this forum
| |
| |
| February 2021 | Sun | Mon | Tue | Wed | Thu | Fri | Sat |
---|
| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | | | | | | | Calendar |
|
|