vb6 实现wav音乐电平的核心代码_vb6 播放wav-优快云博客

本文链接：https://blog.youkuaiyun.com/imperialeast/article/details/143812701

Private Type SUBCHUNK2
SubChunk2ID As String * 4
SubChunk2Size As Long
End Type

Private Type WAVEHEADINFO
ChunkID As String * 4 'RIFF"
ChunkSize As Long
Format As String * 4
SubChunk1ID As String * 4 '===FMT==="
SubChunk1Size As Long
AudioFormat As Integer
NumChannels As Integer '声道
SapleRate As Long '采样频率
ByteRate As Long '码率
BlockAlign As Integer '采样字节
BitsPerSaple As Integer '采样位数 ===FMT END ===
End Type

Type RMSAVER
L_AverRMS As Single 'RMS 均衡值
R_AverRMS As Single
End Type

Public Function GetWaveAverRMS(ByVal lpWav As String, tRMS As RMSAVER, Optional ByVal StartSign As Long = 0, Optional ByVal EndSign As Long = 0, Optional ByVal XDot As Long = 10000) As Boolean
Dim WH As WAVEHEADINFO, SubC As SUBCHUNK2, DataPos As Long, Dsc() As Byte, ListDat() As Byte, WD As WAVEDATA
Dim DataSize As Long, DataLen As Long, XDotDist As Long, OneByte As Byte, wBt(2) As Byte, uTmp(3) As Byte, Yint As Integer, I As Long, J As Integer, FileNum As Integer
Dim Val8 As Long, Val16 As Long, Val24 As Long, V32 As Single, Val32 As Single, V24 As Long, Va24 As Long, L_val As Single, R_val As Single, S_L As Single, S_R As Single, RMS As Single
Dim MaxVal As Long, MinVal As Long, Max32 As Single, SeekPos As Long, D32Len As Long

On Error GoTo Err_RMS

lpWav = StrConv(lpWav, vbUnicode)
FileNum = FreeFile
GetHeadINFOEx lpWav, WH, SubC, DataPos, Dsc, ListDat, WD

Select Case UCase(SubC.SubChunk2ID)
Case "DATA"

DataSize = SubC.SubChunk2Size
If StartSign = 0 And EndSign = 0 Then
DataLen = SubC.SubChunk2Size / WH.BlockAlign
Else
DataLen = Int((EndSign - StartSign) / WH.BlockAlign)
End If
Case "LIST"
DataSize = WD.ChunkSize
If StartSign = 0 And EndSign = 0 Then
DataLen = WD.ChunkSize / WH.BlockAlign
Else
DataLen = Int((EndSign - StartSign) / WH.BlockAlign)
End If
Case Else
End Select

Select Case WH.NumChannels
Case 1

Select Case WH.BitsPerSaple
Case 8

Open lpWav For Binary As #FileNum
If DataLen < XDot Then
For I = 1 To DataLen
Get #FileNum, DataPos + (I - 1) + StartSign, OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
L_val = Val8 ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val
Next
RMS = S_L / (DataLen * 128 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
'单声道右声道和左声值一样
tRMS.R_AverRMS = tRMS.L_AverRMS
Else
XDotDist = DataLen / XDot
For I = 1 To XDot
Get #FileNum, DataPos + Int((I - 1) * XDotDist) + StartSign, OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
L_val = Val8 ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val

Next
RMS = S_L / (XDot * 128 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010 '表示无穷大
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
'单声道右声道和左声值一样
tRMS.R_AverRMS = tRMS.L_AverRMS
End If
Close #FileNum

Case 16
'// 单声道 16 bit
Open lpWav For Binary As #FileNum
If DataLen < XDot Then
For I = 1 To DataLen
Get #FileNum, DataPos + (I - 1) * WH.BlockAlign + StartSign, Yint
If Yint <> 0 Then
L_val = Yint ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val
Next
RMS = S_L / (DataLen * 32768 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
'单声道右声道和左声值一样
tRMS.R_AverRMS = tRMS.L_AverRMS
Else
XDotDist = DataLen / XDot
For I = 1 To XDot
Select Case Int((I - 1) * XDotDist * WH.BlockAlign) Mod WH.BlockAlign
Case 0
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign)
Case 1
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign) + 1
End Select
Get #FileNum, DataPos + SeekPos + StartSign, Yint
If Yint <> 0 Then
L_val = Yint ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val
Next
RMS = S_L / (XDot * 32768 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
'单声道右声道和左声值一样
tRMS.R_AverRMS = tRMS.L_AverRMS
End If
Close #FileNum


End Select

Case 2
'立体声
Select Case WH.BitsPerSaple
Case 8
'// 立体声 8bit
Open lpWav For Binary As #FileNum
If DataLen < XDot Then
For I = 1 To DataLen
'L Channel
Get #FileNum, DataPos + (I - 1) * WH.BlockAlign + StartSign, OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
L_val = Val8 ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val
'R Channel
Get #FileNum, , OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
R_val = Val8 ^ 2
Else
R_val = 0
End If
S_R = S_R + R_val
Next
RMS = S_L / (DataLen * 128 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
RMS = S_R / (DataLen * 128 ^ 2)
If RMS = 0 Then
tRMS.R_AverRMS = -10101010
Else
tRMS.R_AverRMS = (Log(RMS) / Log(10)) * 10 'R Channel
End If
Else
XDotDist = DataLen / XDot
For I = 1 To XDot
Select Case Int((I - 1) * XDotDist * 2) Mod WH.BlockAlign
Case 0
SeekPos = Int((I - 1) * XDotDist * 2)
Case 1
SeekPos = Int((I - 1) * XDotDist * 2) + 1
End Select

'L Channel
Get #FileNum, DataPos + SeekPos + StartSign, OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
L_val = Val8 ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val

'R Channel
Get #FileNum, , OneByte
Val8 = OneByte - 128
If Val8 <> 0 Then
R_val = Val8 ^ 2
Else
R_val = 0
End If
S_R = S_R + R_val

Next
RMS = S_L / (XDot * 128 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If

RMS = S_R / (XDot * 128 ^ 2)
If RMS = 0 Then
tRMS.R_AverRMS = -10101010
Else
tRMS.R_AverRMS = (Log(RMS) / Log(10)) * 10
End If
End If
Close #FileNum

Case 16
'立体声16 bit
Open lpWav For Binary As #FileNum
If DataLen < XDot Then
For I = 1 To DataLen
'L Channel
Get #FileNum, DataPos + (I - 1) * WH.BlockAlign + StartSign, Yint
If Yint <> 0 Then
L_val = Yint ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val
'R Channel
Get #FileNum, , Yint
If Yint <> 0 Then
R_val = Yint ^ 2
Else
R_val = 0
End If
S_R = S_R + R_val
Next

RMS = S_L / (DataLen * 32768 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
RMS = S_R / (DataLen * 32768 ^ 2)
If RMS = 0 Then
tRMS.R_AverRMS = -10101010
Else
tRMS.R_AverRMS = (Log(RMS) / Log(10)) * 10
End If
Else
XDotDist = DataLen / XDot
For I = 1 To XDot
Select Case Int((I - 1) * XDotDist * WH.BlockAlign) Mod WH.BlockAlign
Case 0
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign)
Case 1
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign) + 3
Case 2
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign) + 2
Case 3
SeekPos = Int((I - 1) * XDotDist * WH.BlockAlign) + 1
End Select

'L Channel
Get #FileNum, DataPos + SeekPos + StartSign, Yint
If Yint <> 0 Then
L_val = Yint ^ 2
Else
L_val = 0
End If
S_L = S_L + L_val

'R Channel
Get #FileNum, , Yint
If Yint <> 0 Then
R_val = Yint ^ 2
Else
R_val = 0
End If
S_R = S_R + R_val
Next

RMS = S_L / (XDot * 32768 ^ 2)
If RMS = 0 Then
tRMS.L_AverRMS = -10101010
Else
tRMS.L_AverRMS = (Log(RMS) / Log(10)) * 10
End If
RMS = S_R / (XDot * 32768 ^ 2)
If RMS = 0 Then
tRMS.R_AverRMS = -10101010
Else
tRMS.R_AverRMS = (Log(RMS) / Log(10)) * 10
End If
End If
Close #FileNum

End Select

End Select

'备注： QQ：499932452

GetWaveAverRMS = True
Exit Function
Err_RMS:
GetWaveAverRMS = False
End Function