Option Explicit
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 Const PI As Double = 3.14159265358979 ' 4 * Atn(1)
Private Sub Form_Load()
GenerateTone App.Path & "\Number 1.wav", 697, 1209
GenerateTone App.Path & "\Number 2.wav", 697, 1336
GenerateTone App.Path & "\Number 3.wav", 697, 1477
GenerateTone App.Path & "\Number 4.wav", 770, 1209
GenerateTone App.Path & "\Number 5.wav", 770, 1336
GenerateTone App.Path & "\Number 6.wav", 770, 1477
GenerateTone App.Path & "\Number 7.wav", 852, 1209
GenerateTone App.Path & "\Number 8.wav", 852, 1336
GenerateTone App.Path & "\Number 9.wav", 852, 1477
GenerateTone App.Path & "\Number Star.wav", 941, 1209
GenerateTone App.Path & "\Number 0.wav", 941, 1336
GenerateTone App.Path & "\Number #.wav", 941, 1477
GenerateTone App.Path & "\Dial Tone.wav", 350, 440, , , 2
GenerateTone App.Path & "\Ring Back.wav", 440, 480, , , 2
GenerateTone App.Path & "\Busy.wav", 480, 620, , , 2
End Sub
Private Sub GenerateTone(ByVal FileName As String, ByVal HFrequency As Long, ByVal VFrequency As Long, _
Optional ByVal BitsPerSample As Integer = 16, Optional ByVal SamplesPerSec As Long = 44100, Optional ByVal SecondsLength As Single = 1)
Dim WF As tWAVEFORMATEX
Dim Buff() As Byte, IntBuff() As Integer, K As Long, V1 As Double, H1 As Double
WF.wFormatTag = 1 'WAVE_FORMAT_PCM
WF.nChannels = 1
WF.wBitsPerSample = BitsPerSample
WF.nSamplesPerSec = SamplesPerSec
WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) \ 8
WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
V1 = WF.nSamplesPerSec / (PI * 2 * VFrequency)
H1 = WF.nSamplesPerSec / (PI * 2 * HFrequency)
If WF.wBitsPerSample = 8 Then
ReDim Buff(WF.nSamplesPerSec * SecondsLength - 1)
For K = 0 To UBound(Buff)
Buff(K) = 128 + Fix(Sin(K / V1) * 63.5 + Sin(K / H1) * 63.5)
Next K
Else
ReDim IntBuff(WF.nSamplesPerSec * SecondsLength - 1)
For K = 0 To UBound(IntBuff)
IntBuff(K) = Fix(Sin(K / V1) * 16383.5 + Sin(K / H1) * 16383.5)
Next K
End If
Open FileName For Binary Access Write As #1
WaveWriteHeader 1, WF
If WF.wBitsPerSample = 8 Then
Put #1, , Buff
Else
Put #1, , IntBuff
End If
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 ' "RIFF"
.lFileSize = 0
.lWave = &H45564157 ' "WAVE"
.lFormat = &H20746D66 ' "fmt "
.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 ' "data"
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