Option Explicit
Private Type udtWaveFormatEx
FormatTag As Integer
Channels As Integer
SamplesPerSec As Long
AvgBytesPerSec As Long
BlockAlign As Integer
BitsPerSample As Integer
ExtraDataSize As Integer
End Type
Private Type udtWaveHdr
lpData As Long
dwBufferLength As Long
dwBytesRecorded As Long
dwUser As Long
dwFlags As Long
dwLoops As Long
lpNext As Long
reserved As Long
End Type
Private WaveOut As udtWaveHdr ' Used for playing
Private Type udtWaveCaps
ManufacturerID As Integer
ProductID As Integer
DriverVersion As Long
ProductName(1 To 32) As Byte
Formats As Long
Channels As Integer
reserved As Integer
End Type
Private Const WAVE_FORMAT_PCM = 1
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 Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private WavSound() As Byte
Public UsingWavSound() As Byte
Private WavSoundRecord() As Byte
Private InputDataValue() As Integer ' array to store wave data
Private c_Ptr As Long
Private k_Ptr As Long
Private WaveFormat As udtWaveFormatEx
Public WaveOutDevice As Long
Public WaveOutHandle As Long
Public Pic2Left As Single
Public Pic2Width As Single
Private XMin, XMax As Long ' Xmin and Xmax for display of graph
Private YMin, YMax As Integer ' values for display of graph
Private DataMax As Long ' Total number of integer data in wave file
Dim DataLength As Long
Dim WaitTillDone As Boolean
Dim ArrayFirstChunk As Boolean
Dim k As Single
Dim BarSpeed As Single 'Long
Dim sngLength As Single
Dim nbrDivisions As Single
Dim PlayTime As Single
Dim StartTime As Single
Dim StopTime As Single
Dim i As Long
'========================================================================================================================
' BELOW CODE IF FOR READING IN A FILE INTO AN ARRAY AND PLAYING IT BACK FROM AN ARRAY
'========================================================================================================================
Public Sub WaveIntoArray()
Dim WaveFormat As udtWaveFormatEx
Dim lngReturn As Long
Dim n As Long
Dim nn As Long
frmPlayer.picCover1.Visible = True
frmPlayer.cmdPlayFromLoadedArray.Enabled = False
Open App.Path & "\test1.wav" For Binary As #1
ReDim WavSound(LOF(1) - 1)
Get #1, , WavSound
Close #1
'Load Wave Format with info from file
c_Ptr = 20
WaveFormat.FormatTag = ReadInteger
c_Ptr = 22
WaveFormat.Channels = ReadInteger
c_Ptr = 24
WaveFormat.SamplesPerSec = ReadLong
c_Ptr = 34
WaveFormat.BitsPerSample = ReadInteger
c_Ptr = 32
WaveFormat.BlockAlign = ReadInteger
c_Ptr = 28
WaveFormat.AvgBytesPerSec = ReadLong
WaveFormat.ExtraDataSize = 0
lngReturn = waveOutOpen(WaveOutHandle, WaveOutDevice, VarPtr(WaveFormat), 0, 0, 0)
'Start at offset 44 - Position where actual sound data begins
c_Ptr = 44
ReDim UsingWavSound(UBound(WavSound) - c_Ptr)
'Copy sound data into another array buffer
For n = 44 To UBound(WavSound)
nn = n - 44
UsingWavSound(nn) = ReadByte
Next n
' Get the progressbar movement data and the playing time
sngLength = UBound(UsingWavSound) - 1
nbrDivisions = frmPlayer.Picture1.ScaleWidth / sngLength
DataMax = UBound(UsingWavSound) / 2
' Draw the sine wave graph
DisplayGraph1
frmPlayer.cmdPlayFromLoadedArray.Enabled = True
End Sub
Public Sub PlayFromLoadedArray()
Dim lngReturn As Long
WaveOut.lpData = VarPtr(UsingWavSound(0))
WaveOut.dwBufferLength = UBound(UsingWavSound())
WaveOut.dwLoops = 1
WaveOut.dwFlags = WaveOut.dwFlags Or WHDR_BEGINLOOP
WaveOut.dwFlags = WaveOut.dwFlags Or WHDR_ENDLOOP
lngReturn = waveOutPrepareHeader(WaveOutHandle, VarPtr(WaveOut), Len(WaveOut))
If lngReturn = 0 Then
WaveOutTime.wType = TIME_BYTES
frmPlayer.picCover1.Visible = False
frmPlayer.cmdLoadWaveIntoArray.Enabled = False
frmPlayer.Timer1.Enabled = True
' Start playing the sound
lngReturn = waveOutWrite(WaveOutHandle, VarPtr(WaveOut), Len(WaveOut))
Else
MsgBox GetMMError(lngReturn)
End If
End Sub
Public Sub sinewaveDisplay()
'Timer1 used to control the progress bar across the sine wave display
Dim lngResult As Long
Dim sngPosition As Single
Dim L As Single, W As Single
lngResult = waveOutGetPosition(WaveOutHandle, VarPtr(WaveOutTime), Len(WaveOutTime))
If lngResult = 0 Then
sngPosition = WaveOutTime.u * nbrDivisions
' Get incremental amount to move progress bar
L = Pic2Left + sngPosition
W = Pic2Width - sngPosition
On Error Resume Next
frmPlayer.Picture2.Move L, frmPlayer.Picture2.Top, W, frmPlayer.Picture2.Height
If WaveOutTime.u >= sngLength Then
' If end of scale then reset some properties
frmPlayer.Timer1.Enabled = False
frmPlayer.cmdPlayFromLoadedArray.Enabled = False
frmPlayer.cmdLoadWaveIntoArray.Enabled = True
frmPlayer.picCover1.Visible = True
frmPlayer.Picture1.Cls
frmPlayer.Picture2.Left = Pic2Left
frmPlayer.Picture2.Width = Pic2Width
CloseWaveOut
End If
Else
' Let's hope it doesn't come here
frmPlayer.Timer1.Enabled = False
CloseWaveOut
MsgBox GetMMError(lngResult)
End If
End Sub
Public Sub CloseWaveOut()
Dim lngReturn As Long
lngReturn = waveOutReset(WaveOutHandle)
lngReturn = waveOutUnprepareHeader(WaveOutHandle, VarPtr(WaveOut), Len(WaveOut))
lngReturn = waveOutClose(WaveOutHandle)
End Sub
'========================================================================================================================
' Below code are helper functions
'========================================================================================================================
Private Function ReadString(nbrBytes As Long) As String
'
' Read a String (variable number of bytes) Value
ReDim aBuff(0 To nbrBytes - 1)
CopyMemory aBuff(0), WavSound(c_Ptr), nbrBytes
ReadString = StrConv(aBuff, vbUnicode)
c_Ptr = c_Ptr + nbrBytes
End Function
Private Function ReadInteger() As Integer
'
' Read an Integer (2 byte) Value
'
CopyMemory ReadInteger, WavSound(c_Ptr), 2&
c_Ptr = c_Ptr + 2
End Function
Private Function ReadLong() As Long
'
' Read a Long (4 byte) Value
'
CopyMemory ReadLong, WavSound(c_Ptr), 4&
c_Ptr = c_Ptr + 4
End Function
Private Sub ReadVariable(ByVal nbrBytes As Long)
'
' Read one or more bytes
'
ReDim aBuff(0 To nbrBytes - 1)
CopyMemory aBuff(0), WavSound(c_Ptr), nbrBytes
c_Ptr = c_Ptr + nbrBytes
End Sub
Private Function ReadByte() As Byte
'
' Read one byte
'
ReadByte = WavSound(c_Ptr)
c_Ptr = c_Ptr + 1
End Function
'=====================================================================================================================
Private Sub DisplayGraph1()
YMin = 32767
YMax = -32768
XMin = 0
XMax = DataMax
frmPlayer.Picture1.Scale (XMin, YMin)-(XMax, YMax) ' Set up a user defined scale mode
c_Ptr = 44
For i = XMin To XMax - 2
frmPlayer.Picture1.PSet (i, ReadInteger) ' maps the wave data to picture box
Next i
frmPlayer.Picture1.ScaleMode = vbPixels
End Sub
Private Function ReadInt() As Integer
'
' Read an Integer (2 byte) Value
'
CopyMemory ReadInt, WavSoundRecord(k_Ptr), 2&
k_Ptr = k_Ptr + 2
End Function