This code works to output a piano tone for 2 seconds using winmm.dll via platform invocation services, it seems to work fine on XP but waveoutopen fails in windows 7 rc
updated based on feedback from John Knoeller
Imports System.Runtime.InteropServices
Public Class AudioStream
<StructLayout(LayoutKind.Sequential)> _
Private Structure WAVEHDR
Public lpData As Integer
Public dwBufferLength As Integer
Public dwBytesRecorded As Integer
Public dwUser As Integer
Public dwFlags As Integer
Public dwLoops As Integer
Public lpNext As Integer
Public Reserved As Integer
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 Declare Function waveOutOpen Lib "winmm.dll" (ByRef lphWaveOut As Int32, ByVal uDeviceID As Int32, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As WaveDelegate, ByVal dwInstance As Int32, ByVal dwFlags As Int32) As Int32
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Int32) As Int32
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Delegate Sub WaveDelegate(ByVal hwo As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByRef wavhdr As WAVEHDR, ByVal dwParam2 As Integer)
Private Const WAVE_MAPPER = -1&
Private Const WAVE_FORMAT_PCM = 1
Private Const CALLBACK_FUNCTION = &H30000 ' to set up a callback to a function
Private Const WHDR_DONE = &H1 ' done bit
Private Const WHDR_PREPARED = &H2 ' set if this header has been prepared
Private Const WHDR_BEGINLOOP = &H4 ' loop start block
Private Const WHDR_ENDLOOP = &H8 ' loop end block
Private Const WHDR_INQUEUE = &H10 ' reserved for driver
Private Const MM_WOM_OPEN = &H3BB ' waveform output
Private Const MM_WOM_CLOSE = &H3BC
Private Const MM_WOM_DONE = &H3BD
Private Const WOM_OPEN = MM_WOM_OPEN
Private Const WOM_CLOSE = MM_WOM_CLOSE
Private Const WOM_DONE = MM_WOM_DONE
Private Const MMSYSERR_BASE = 0
Private Const MMSYSERR_NOERROR = 0 ' no error
Private Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1) ' unspecified error
Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2) ' device ID out of range
Private Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3) ' driver failed enable
Private Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4) ' device already allocated
Private Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5) ' device handle is invalid
Private Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6) ' no device driver present
Private Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7) ' memory allocation error
Private Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8) ' function isn't supported
Private Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9) ' error value out of range
Private Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10) ' invalid flag passed
Private Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11) ' invalid parameter passed
Private Const MMSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12) ' handle being used simultaneously on another thread (eg callback) */
Private Const MMSYSERR_INVALIDALIAS = (MMSYSERR_BASE + 13) ' specified alias not found
Private Const MMSYSERR_BADDB = (MMSYSERR_BASE + 14) ' bad registry database
Private Const MMSYSERR_KEYNOTFOUND = (MMSYSERR_BASE + 15) ' registry key not found
Private Const MMSYSERR_READERROR = (MMSYSERR_BASE + 16) ' registry read error
Private Const MMSYSERR_WRITEERROR = (MMSYSERR_BASE + 17) ' registry write error
Private Const MMSYSERR_DELETEERROR = (MMSYSERR_BASE + 18) ' registry delete error
Private Const MMSYSERR_VALNOTFOUND = (MMSYSERR_BASE + 19) ' registry value not found
Private Const MMSYSERR_NODRIVERCB = (MMSYSERR_BASE + 20) ' driver does not call DriverCallback
Private Const MMSYSERR_MOREDATA = (MMSYSERR_BASE + 21) ' more data to be returned
Private Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 21) ' last error in range
Private Const WAVERR_BASE = 32
Private Const WAVERR_BADFORMAT = (WAVERR_BASE + 0) ' unsupported wave format
Private Const WAVERR_STILLPLAYING = (WAVERR_BASE + 1) ' still something playing
Private Const WAVERR_UNPREPARED = (WAVERR_BASE + 2) ' header not prepared
Private Const WAVERR_SYNC = (WAVERR_BASE + 3) ' device is synchronous
Private Const WAVERR_LASTERROR = (WAVERR_BASE + 3) ' last error in range
Private FinishedPlaying As Boolean ' local flag to track playback status
Private mCallBack As WaveDelegate = AddressOf WaveCallBack ' function pointer to our callback function
Private pmem As IntPtr ' heap memory pointer
''' <summary>
''' Play a tone of a specified hz frequency for a specified duration in seconds
''' </summary>
Public Sub Play(ByVal Frequency As Single, ByVal Seconds As Single)
Dim wavFormat As WAVEFORMATEX
Dim wavHead As WAVEHDR
Dim hWaveOut As Int32
With wavFormat
.wFormatTag = WAVE_FORMAT_PCM
.nChannels = 2
.wBitsPerSample = 16
.nSamplesPerSec = 44100
.nBlockAlign = .nChannels * .wBitsPerSample / 8
.nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
End With
Dim BufferSamples As Integer = wavFormat.nSamplesPerSec * Seconds
Dim BufferBytes As Integer = BufferSamples * wavFormat.nBlockAlign
'allocate memory on the heap
pmem = Marshal.AllocHGlobal(BufferBytes)
With wavHead
.lpData = pmem.ToInt32
.dwBufferLength = BufferBytes
End With
waveOutOpen(hWaveOut, WAVE_MAPPER, wavFormat, mCallBack, 0, CALLBACK_FUNCTION)
waveOutPrepareHeader(hWaveOut, wavHead, Len(wavHead))
FinishedPlaying = False
' fill buffer with specific frequency
Dim SamplesPerCycle As Double = wavFormat.nSamplesPerSec / Frequency
For i As Integer = 0 To BufferSamples - 1
' 16-bit samples are stored as 2's-complement signed integers, ranging from -32768 to 32767
Dim RotationPercent As Double = (i Mod SamplesPerCycle) / SamplesPerCycle
Dim RotationRadians As Double = RotationPercent * Math.PI * 2
Dim SampleValue As Int16 = Math.Sin(RotationRadians) * Int16.MaxValue
' blocks are 4 bytes - 2 bytes for left channel then 2 bytes for right channel
' left channel
Marshal.WriteInt16(pmem, i * wavFormat.nBlockAlign, SampleValue)
' right channel
Marshal.WriteInt16(pmem, (i * wavFormat.nBlockAlign) + 2, SampleValue)
Next
' play buffer
waveOutWrite(hWaveOut, wavHead, Len(wavHead))
Do While (Not FinishedPlaying)
Application.DoEvents()
Loop
waveOutUnprepareHeader(hWaveOut, wavHead, Len(wavHead))
waveOutClose(hWaveOut)
'free memory we allocated on the heap
Marshal.FreeHGlobal(pmem)
End Sub
''' <summary>
''' This is our handler for the waveout API callback
''' </summary>
Private Sub WaveCallBack(ByVal hwo As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByRef wavhdr As WAVEHDR, ByVal dwParam2 As Integer)
Select Case uMsg
Case MM_WOM_OPEN
Debug.WriteLine("Open")
Case WOM_DONE
FinishedPlaying = True
Case Else
Debug.WriteLine(uMsg)
End Select
End Sub
''' <summary>
''' This is a convienient entry point to allow the class to be executed standalone (by configuring project properties)
''' </summary>
Public Shared Sub Main()
Dim BeatsPerMinute As Double = 120
Dim BeatsPerSecond As Double = BeatsPerMinute / 60
Dim ScaleSteps() As Integer = {0, 2, 2, 1, 2, 2, 2, 1} ' tone steps for major scale
Dim MyAudioStream As New AudioStream
Dim ToneFrequency As Double = 261.626 ' 261.626hz middle c piano tone
For t As Integer = 0 To ScaleSteps.Length - 1
For s As Integer = 1 To ScaleSteps(t)
ToneFrequency *= 1.05946309435929 ' Twelfth root of two for next tone
Next
MyAudioStream.Play(ToneFrequency, 1 / BeatsPerSecond) ' play tone for one second
Next
End Sub
End Class
Your buffer is too small, change this
to this
Edit: I don’t see how this works at all, you declare the audio as 44khz, 16 bit stereo.
but then you fill the audio buffer with 32bit mono. So the size of the data works out, but the audio data itself is wrong.
Also, nBlockAlign should be number of bytes per sample * number of channels.
Edit2: I keep finding more problems. I’m not a VB guy, but I’ll try and write out what the code should look like, you may have to fix syntax errors.