|
-
May 14th, 2009, 10:40 AM
#1
Creating .wav files - getting "clicks"
All,
I am creating some sounds using the following code (got the basis of it from this forum):
Code:
Option Explicit
Private Incr As Integer
Private I As Integer
Private fName As String
Private Buff(0 To 44100) As Integer
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Type tWAVEFORMATEX
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
End Type
Private Type FileHeader
lRiff As Long
lFileSize As Long
lWave As Long
lFormat As Long
lFormatLength As Long
End Type
Private Type WaveFormat
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
End Type
Private Type ChunkHeader
lType As Long
lLen As Long
End Type
Private Sub cmdNote_Click(Index As Integer)
Dim I As Integer
Incr = txtFreq.Text
Select Case Index
Case 0
GenerateTone 261.63, Buff, 1
fName = "c:\wave262.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 1
GenerateTone 293.66, Buff, 1
fName = "c:\wave294.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 2
GenerateTone 329.63, Buff, 1
fName = "c:\wave330.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 3
GenerateTone 349.23, Buff, 1
fName = "c:\wave349.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 4
GenerateTone 392, Buff, 1
fName = "c:\wave392.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 5
GenerateTone 440, Buff, 1
fName = "c:\wave440.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 6
GenerateTone 493.88, Buff, 1
fName = "c:\wave494.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 7
GenerateTone 523.25, Buff, 1
fName = "c:\wave523.wav"
SaveWaveFile fName, Buff
PlaySound fName, ByVal 0&, SND_FILENAME Or SND_ASYNC
Case 99
Timer1.Enabled = True
End Select
End Sub
Private Sub GenerateTone(ByVal Frequency As Single, _
intBuff() As Integer, Optional Amplitude As Single = 1, _
Optional SamplesPerSec As Long = 44100, _
Optional startPos As Long = 0, Optional Length As Long = -1)
Dim K As Long, V1 As Double
Const Pi As Double = 3.14159265358979
V1 = SamplesPerSec / (Pi * 2 * Frequency)
'If Length = -1 Then Length = UBound(intBuff) - startPos
Length = 5512
For K = startPos To startPos + Length
intBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
Next K
End Sub
Private Sub SaveWaveFile(ByVal WaveFileName As String, _
ByRef buffer() As Integer, Optional SamplesPerSec As Long = 44100)
Dim wF As tWAVEFORMATEX
wF.wFormatTag = 1
wF.nChannels = 1
wF.wBitsPerSample = 16
wF.nSamplesPerSec = SamplesPerSec
wF.nBlockAlign = (wF.wBitsPerSample * wF.nChannels) / 8
wF.nAvgBytesPerSec = wF.nSamplesPerSec * wF.nBlockAlign
Open WaveFileName For Binary Access Write Lock Write As #1
WaveWriteHeader 1, wF
Put #1, , buffer
WaveWriteHeaderEnd 1
Close #1
End Sub
Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, _
WaveFmt As tWAVEFORMATEX)
Dim Header As FileHeader
Dim HdrFormat As WaveFormat
Dim Chunk As ChunkHeader
With Header
.lRiff = &H46464952
.lFileSize = 0
.lWave = &H45564157
.lFormat = &H20746D66
.lFormatLength = Len(HdrFormat)
End With
With HdrFormat
.wFormatTag = WaveFmt.wFormatTag
.nChannels = WaveFmt.nChannels
.nSamplesPerSec = WaveFmt.nSamplesPerSec
.nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
.nBlockAlign = WaveFmt.nBlockAlign
.wBitsPerSample = WaveFmt.wBitsPerSample
End With
Chunk.lType = &H61746164
Chunk.lLen = 0
Put #OutFileNum, 1, Header
Put #OutFileNum, , HdrFormat
Put #OutFileNum, , Chunk
End Sub
Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
Dim Header As FileHeader
Dim HdrFormat As WaveFormat
Dim Chunk As ChunkHeader
Dim Lng As Long
Lng = LOF(OutFileNum)
Put #OutFileNum, 5, Lng
Lng = LOF(OutFileNum) - (Len(Header) + Len(HdrFormat) + Len(Chunk))
Put #OutFileNum, Len(Header) + Len(HdrFormat) + 5, Lng
End Sub
Private Sub Timer1_Timer()
If I > 7 Then
Timer1.Enabled = False
I = 0
Exit Sub
End If
cmdNote_Click (I)
I = I + 1
End Sub
When I play back the sounds (in particular the 8 notes in succession, middle C on up...), I get nasty clicks. I've read a few posts on how to avoid that, but have not had any luck.
Can anyone help me make the clicks go away?
Thanks!
Bryce
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|