4
Ноябрь
2009
Модуль для работы с wav файлами
Модуль для работы с wav файлами.
Возможности:
-читать и записывать заголовок файла;
-читать данные файла(массив данных);
-создавать пустой wav файл;
-получать длину wav файла в секундах или семплах.
Option Explicit
'===============================
'Модуль для работы с wav файлами
'Автор - Волков Антон
'===============================
' ===================================================================================================
Enum LEN_FORMAT
frmSeconds = 0
frmSamples = 1
End Enum
Type RIFF_HEAD
riffFmt As String * 4
lenOfFileData As Long
End Type
Type WAVE_HEAD
waveFmt As String * 8
lenOfThunk As Long
format As Integer
channels As Integer
samplesPerSecond As Long
avgBytesPerSecond As Long
blockAlign As Integer
bitsPerSample As Integer
End Type
Type DATA_HEAD
dataStr As String * 4
lenOfThunk As Long
End Type
' ===================================================================================================
' Функция возвращает массив данных из WAV файла
Public Function ReadWaveData(ByVal fileName As String, Optional howMany As Long) As Variant
On Error GoTo ERRH
Dim freeNum As Long
Dim size As Long
Dim bits As Byte
freeNum = FreeFile
Open fileName For Binary As #freeNum
Get #freeNum, 41, size
Get #freeNum, 35, bits
If bits = 8 Then
Dim arrByte() As Byte
Else
Dim arrInteger() As Integer
End If
If howMany < 0 Then
If bits = 8 Then
ReDim arrByte(size - 1)
Else
ReDim arrInteger(Int(size / 2) - 1)
End If
Else
If howMany > size Or howMany = 0 Then howMany = size
If bits = 8 Then
ReDim arrByte(howMany - 1)
Else
ReDim arrInteger(howMany - 1)
End If
End If
If bits = 8 Then
Get #freeNum, 45, arrByte
Else
Get #freeNum, 45, arrInteger
End If
Close #freeNum
If bits = 8 Then
ReadWaveData = arrByte
Else
ReadWaveData = arrInteger
End If
Exit Function
ERRH:
ReadWaveData = False
End Function
' ===================================================================================================
' Читает заголовок WAV файла
Public Function ReadWaveHeader(ByVal fileName As String, ByRef riffHead As RIFF_HEAD, ByRef waveHead As WAVE_HEAD, ByRef dataHead As DATA_HEAD) As Boolean
On Error GoTo ERRH
Dim freeNum As Long
freeNum = FreeFile
Open fileName For Binary As #freeNum
Get #freeNum, , riffHead
Get #freeNum, , waveHead
Get #freeNum, , dataHead
Close #freeNum
ReadWaveHeader = True
Exit Function
ERRH:
ReadWaveHeader = False
End Function
' ===================================================================================================
' Переписать заголовок WAV файла
Public Function WriteNewWaveHeader(ByVal fileName As String, ByRef riffHead As RIFF_HEAD, ByRef waveHead As WAVE_HEAD, ByRef dataHead As DATA_HEAD) As Boolean
On Error GoTo ERRH
Dim freeNum As Long
freeNum = FreeFile
Open fileName For Binary As #freeNum
Put #freeNum, , riffHead
Put #freeNum, , waveHead
Put #freeNum, , dataHead
Close #freeNum
WriteNewWaveHeader = True
Exit Function
ERRH:
WriteNewWaveHeader = False
End Function
' ===================================================================================================
' Создать WAV файл
Public Function CreateWaveFile(ByVal fileName As String, ByRef waveHead As WAVE_HEAD, ByVal waveData As Variant) As Boolean
On Error GoTo ERRH
Dim riffHead As RIFF_HEAD
Dim dataHead As DATA_HEAD
Dim freeNum As Long
Dim arrBound As Long
Dim arrToPut() As Byte
freeNum = FreeFile
arrBound = UBound(waveData)
Open fileName For Binary As #freeNum
riffHead.riffFmt = "RIFF"
riffHead.lenOfFileData = arrBound + 37
Put #freeNum, , riffHead
waveHead.lenOfThunk = 16
waveHead.waveFmt = "WAVEfmt "
Put #freeNum, , waveHead
dataHead.lenOfThunk = arrBound + 1
dataHead.dataStr = "data"
Put #freeNum, , dataHead
ReDim arrToPut(arrBound)
arrToPut = waveData
Put #freeNum, , arrToPut
Close #freeNum
CreateWaveFile = True
Exit Function
ERRH:
CreateWaveFile = False
End Function
' ===================================================================================================
' Получить длину WAV файла (в сек. или в сэмплах)
Public Function GetLenOfWaveFile(ByVal fileName As String, format As LEN_FORMAT) As Single
Dim riffHead As RIFF_HEAD
Dim waveHead As WAVE_HEAD
Dim dataHead As DATA_HEAD
ReadWaveHeader fileName, riffHead, waveHead, dataHead
If format = frmSeconds Then
GetLenOfWaveFile = (dataHead.lenOfThunk / waveHead.samplesPerSecond)
Else
GetLenOfWaveFile = dataHead.lenOfThunk
End If
End Function
А вот пример использования:
В диске D создайте wav файл с названием «2.wav» , можете записать с микрофона и сохранить туда.
На форму поставьте Text1 , Text2, Command1, Picture1.
Добавьте модуль с названием WaveFunctions и запишите туда вышенаписанный код.
А в самой форме код такой:
Dim kk1() As Integer 'массив для файлов больше 8бит
Dim kk2() As Byte 'массив для файлов до 8 бит
Dim sec As Single 'секунды
Dim samp As Integer 'семплы
Private Sub Command1_Click()
sec = WaveFunctions.GetLenOfWaveFile("D:\2.wav", frmSeconds)
samp = WaveFunctions.GetLenOfWaveFile("D:\2.wav", frmSamples)
Text1.Text = sec
Text2.Text = samp
kk2() = WaveFunctions.ReadWaveData("D:\2.wav") 'читаем данные в массив из файла D:\2.wav
For i = 1 To samp - 1 ' это кол-во сэмплов samp минус 1
Picture1.PSet (i, 900 + kk2(i) * 2) 'рисуем точки
Next i
End Sub