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 Sub Form_Load()
Dim Buff(0 To 44100) As Integer
GenerateTone 440, Buff, 1
SaveWaveFile "C:\test_Wave.wav", Buff
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
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 'WAVE_FORMAT_PCM
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 ' "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