- Код: Выделить всё
Option Explicit
' ===================================================================================================
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 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
' ===================================================================================================
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
[Viper] :: Пользуйся тэгом CODE!
