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