vb播放wav音乐也能实现电平功能

imperialeast

vb也可以实现播放wav音乐的电平功能
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


'在窗体中timer事件
Private Sub TSound_Timer()
Dim tRMS As RMSAVER, SmallNum As Long, EndNum As Long


'If GetMusicPosition > 0 Then
‘GetMusicPosition 获取音乐播放的位置  GetByteRate 1秒过去多少字节的数据
           SmallNum = Int(GetMusicPosition * (GetByteRate(NowPath) / 1000))
                GetWavDataInfo NowPath, WDI
                                  Select Case WDI.NumChannels
                                             
                                         Case 1 '单声道
                                            Select Case WDI.BitsPerSaple
                                                   Case 8
                                                        SmallNum = SmallNum
                                                   Case 16
                                                        Select Case SmallNum Mod WDI.BlockAlign
                                                               Case 0
                                                                  SmallNum = SmallNum
                                                               Case 1
                                                                  SmallNum = SmallNum + 1
                                                        End Select
                                                   Case 24
                                                        Select Case SmallNum Mod WDI.BlockAlign
                                                               Case 0
                                                                  SmallNum = SmallNum
                                                               Case 1
                                                                  SmallNum = SmallNum + 2
                                                               Case 2
                                                               SmallNum = SmallNum + 1
                                                        End Select
                                                   
                                                   Case 32
                                                        Select Case SmallNum Mod WDI.BlockAlign
                                                               Case 0
                                                                  SmallNum = SmallNum
                                                               Case 1
                                                                  SmallNum = SmallNum + 3
                                                               Case 2
                                                               SmallNum = SmallNum + 2
                                                               Case 3
                                                               SmallNum = SmallNum + 1
                                                        End Select
                                                   
                                            End Select
                                         Case 2 '立体声
                                                  Select Case WDI.BitsPerSaple
                                                         Case 8
                                                              Select Case SmallNum Mod WDI.BlockAlign
                                                                     Case 0
                                                                        SmallNum = SmallNum
                                                                     Case 1
                                                                        SmallNum = SmallNum + 1
                                                              End Select
                                                         Case 16
                                                              Select Case SmallNum Mod WDI.BlockAlign
                                                                     Case 0
                                                                        SmallNum = SmallNum
                                                                     Case 1
                                                                        SmallNum = SmallNum + 3
                                                                     Case 2
                                                                        SmallNum = SmallNum + 2
                                                                     Case 3
                                                                        SmallNum = SmallNum + 1
                                                              End Select
                                                         Case 24
                                                              Select Case SmallNum Mod WDI.BlockAlign
                                                                     Case 0
                                                                        SmallNum = SmallNum
                                                                     Case 1
                                                                        SmallNum = SmallNum + 5
                                                                     Case 2
                                                                        SmallNum = SmallNum + 4
                                                                     Case 3
                                                                        SmallNum = SmallNum + 3
                                                                     Case 4
                                                                        SmallNum = SmallNum + 2
                                                                     Case 5
                                                                        SmallNum = SmallNum + 1
                                                              End Select
                                                         
                                                         Case 32
                                                              Select Case SmallNum Mod WDI.BlockAlign
                                                                     Case 0
                                                                        SmallNum = SmallNum
                                                                     Case 1
                                                                        SmallNum = SmallNum + 7
                                                                     Case 2
                                                                        SmallNum = SmallNum + 6
                                                                     Case 3
                                                                        SmallNum = SmallNum + 5
                                                                     Case 4
                                                                        SmallNum = SmallNum + 4
                                                                     Case 5
                                                                        SmallNum = SmallNum + 3
                                                                     Case 6
                                                                        SmallNum = SmallNum + 2
                                                                     Case 7
                                                                        SmallNum = SmallNum + 1
                                                                     
                                                              End Select
                                                         
                                                  End Select
                                  End Select
                  
                     EndNum = SmallNum + GetByteRate(NowPath) / 25
                     GetWaveBuffAverRMS NowPath, tRMS, SmallNum, EndNum, 50000
                       
                       
                     
                    ’  (100 + tRMS.L_AverRMS)   左声道电平音值
                    ‘  (100 + tRMS.R_AverRMS)  右声道电平音值
        

End Sub




’要用到的相关函数
Type WAVEDATAINFO
     NumChannels As Integer     '声道
     SapleRate As Long          '采样频率
     BitsPerSaple As Integer    '采样位数
     BlockAlign As Integer      '采样字节
     DataPos As Long
     DataSize As Long
End Type

Type WAVEDATA
     ChunkID As String * 4
     ChunkSize As Long
End Type

'Use Byte() To Type
Private Function GetWaveListType(Dat() As Byte, LstType As LSTDATAINFO) As Boolean
  On Error GoTo Err_LHD
   Call RtlMoveMemory(LstType, Dat(0), ByVal UBound(Dat))
    GetWaveListType = True
   Exit Function
Err_LHD:
    GetWaveListType = False
End Function

'Byte Rate 比特率
Public Function GetByteRate(ByVal lpWav As String) As Long
Dim RifFmt(35) As Byte, WH As WAVEHEADINFO
lpWav = StrConv(lpWav, vbUnicode)
GetWavDat lpWav, RifFmt
GetWavHead RifFmt, WH
GetByteRate = WH.ByteRate
End Function

'GET  DATA
Private Function GetWavDat(ByVal lpWay As String, ByRef uGetDat() As Byte, Optional ByVal StartPos As Long = 1) As Long
Dim FileNum As Integer
On Error GoTo Err_gDat

FileNum = FreeFile
If Dir(lpWay, 31) <> "" Then
  Open lpWay For Binary As #FileNum
    Get #FileNum, StartPos, uGetDat
  Close #FileNum
End If
  GetWavDat = 1
  Exit Function
Err_gDat:
Close #FileNum
GetWavDat = -1
End Function

'Get Head Form Type
Private Function GetWavHead(Dat() As Byte, lW As WAVEHEADINFO) As Long
  On Error GoTo Err_WH
  Call RtlMoveMemory(lW, Dat(0), ByVal UBound(Dat))
  GetWavHead = 1
  Exit Function
Err_WH:
   GetWavHead = -1
End Function

Private Function GetHeadINFOEx(ByVal lpWay As String, WH As WAVEHEADINFO, SubC As SUBCHUNK2, DatPos As Long, Dsc() As Byte, ListDat() As Byte, WD As WAVEDATA) As Long
  Dim RifFmt(35) As Byte, cBt(8) As Byte, LtD As LSTDATAINFO
  On Error GoTo Err_HDIFOEx
  GetWavDat lpWay, RifFmt
  GetWavHead RifFmt, WH
     
     GetWavDat lpWay, cBt, 37 + (Val(WH.SubChunk1Size) - 16)
     
     GetWaveListType cBt, LtD
    '// MsgBox LtD.Size
    '//Debug.Print LtD.ID & "," & LtD.Size & "---" & WH.ChunkSize
     Select Case UCase(LtD.ID)
            Case "DATA"
                 'Rule WAVE
                  With SubC
                        .SubChunk2ID = LtD.ID
                        .SubChunk2Size = LtD.Size
                  End With
               
                '//MsgBox LtD.ID & "||" & LtD.Size
                If WH.SubChunk1Size > 16 Then
                  ReDim Dsc(Val(WH.SubChunk1Size) - 16 - 1)
                  Call GetWavDat(lpWay, Dsc, 37)
                End If
                DatPos = Val(WH.SubChunk1Size) - 16 + 45
            Case "LIST"
                 'Extend WAVE
                Dim DL As LSTDATAINFO
                 GetWavDat lpWay, cBt, LtD.Size + 45 + (Val(WH.SubChunk1Size) - 16)
                 GetWaveListType cBt, DL
                  '// Debug.Print DL.ID & "," & DL.Size & "====" & wh.ChunkSize
                  
                     With SubC
                           .SubChunk2ID = LtD.ID
                           .SubChunk2Size = LtD.Size
                     End With
                     
                      If WH.SubChunk1Size > 16 Then
                       ReDim Dsc(Val(WH.SubChunk1Size) - 16 - 1)
                       Call GetWavDat(lpWay, Dsc, 37)
                      End If
                     'list and description
                     ReDim ListDat(LtD.Size - 1) As Byte
                     
                     Call GetWavDat(lpWay, ListDat, 37 + Val(WH.SubChunk1Size) - 16 + 8)
               
                     WD.ChunkID = DL.ID
                     WD.ChunkSize = DL.Size
                     DatPos = LtD.Size + 37 + Val(WH.SubChunk1Size) - 16 + 8 + 8
            Case Else
                 'UNKNOWN
               
                   '目前这个只是针对不规则的数据注释进行枚举,否则按照标准这些文件信息是无法正确读取的
                 Dim RndPos As Integer
                 
                    Do Until GetRuleID(LtD.ID) = True And UCase(LtD.ID) = "DATA"
                     
                      GetWavDat lpWay, cBt, 37 + RndPos + (Val(WH.SubChunk1Size) - 16)
                      GetWaveListType cBt, LtD
                      RndPos = RndPos + 1
                     
                    Loop
                                       
                    SubC.SubChunk2ID = LtD.ID
                    SubC.SubChunk2Size = LtD.Size
                  
                  '// ==== Get Description Message ====
                   ReDim Dsc(RndPos + (Val(WH.SubChunk1Size) - 16) - 2)
                   GetWavDat lpWay, Dsc, 37
                 
                  DatPos = 37 + RndPos + (Val(WH.SubChunk1Size) - 16) - 1 + 8
                ' MsgBox "傻,又想冒充我!", vbInformation, " 真多!!!!"
      End Select
     
    GetHeadINFOEx = 1
Exit Function
Err_HDIFOEx:
GetHeadINFOEx = -1
End Function

Public Function GetWavDataInfo(ByVal lpWav As String, WDI As WAVEDATAINFO) As Boolean
Dim WH As WAVEHEADINFO, SubC As SUBCHUNK2, DataPos As Long, Dsc() As Byte, ListDat() As Byte, WD As WAVEDATA
  lpWav = StrConv(lpWav, vbUnicode)
  On Error GoTo Err_Data_Info
   GetHeadINFOEx lpWav, WH, SubC, DataPos, Dsc, ListDat, WD
   
       With WDI
            .BitsPerSaple = WH.BitsPerSaple
            .NumChannels = WH.NumChannels
            .SapleRate = WH.SapleRate
            .BlockAlign = WH.BlockAlign
            .DataPos = DataPos
        Select Case UCase(SubC.SubChunk2ID)
                Case "DATA"
                  'DataLenByte = SubC.SubChunk2Size / WH.BlockAlign
                   .DataSize = SubC.SubChunk2Size
                Case "LIST"
                  'DataLenByte = WD.ChunkSize / WH.BlockAlign
                   .DataSize = WD.ChunkSize
               Case Else
        End Select
  
       End With
  GetWavDataInfo = True
  
  Exit Function
  
Err_Data_Info:
   GetWavDataInfo = False
End Function