VB多声卡录音控件及源代码

【实例简介】

VB多声卡录音控件及源代码，可以选择不同声卡，同时录音

【实例截图】

【核心代码】

Option Explicit
                                                                 
'
Private WithEvents clsRecorder  As WaveInRecorder
Private WithEvents MyRecorder   As WaveInRecorder
Private clsDSP                  As clsDSP
Private intSamples()            As Integer
Private clsEncoder              As EncoderWAV
Private lngMSEncoded            As Long
Private lngBytesPerSec          As Long
'
Const FFT_SAMPLES               As Long = 1024
'
'事件声明:
'
'缺省属性值:
Const m_def_MixerLineVolume = 65535                                             '录音音量
Const m_def_DeviceNumber = 0                                                    '设备数量
Const m_def_DeviceName = ""                                                     '设备名称
Const m_def_FileName = "c:\test.wav"                                            '文件名称
Const m_def_RecordState = False                                                 '录音状态
Const m_def_SampleValue = 0
'属性变量:
Dim m_MixerLineVolume           As Long
Dim m_DeviceNumber              As Long
Dim m_DeviceName                As String
Dim m_FileName                  As String
Dim m_RecordState               As Boolean
Dim m_SampleValue               As Long

Private Sub tmrVis_Timer()
    '
    On Error Resume Next
    '
    If clsRecorder.IsRecording Then
        '
        m_SampleValue = GetArrayMaxAbs(intSamples)
        '
    End If
    '
End Sub
                                                                         
'
'
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    '
    m_MixerLineVolume = PropBag.ReadProperty("MixerLineVolume", m_def_MixerLineVolume)
    m_DeviceNumber = PropBag.ReadProperty("DeviceNumber", m_def_DeviceNumber)
    m_DeviceName = PropBag.ReadProperty("DeviceName", m_def_DeviceName)
    m_FileName = PropBag.ReadProperty("FileName", m_def_FileName)
    m_RecordState = PropBag.ReadProperty("RecordState", m_def_RecordState)
    m_SampleValue = PropBag.ReadProperty("SampleValue", m_def_SampleValue)
    '
End Sub
                                                                         
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    '
    Call PropBag.WriteProperty("MixerLineVolume", m_MixerLineVolume, m_def_MixerLineVolume)
    Call PropBag.WriteProperty("DeviceNumber", m_DeviceNumber, m_def_DeviceNumber)
    Call PropBag.WriteProperty("DeviceName", m_DeviceName, m_def_DeviceName)
    Call PropBag.WriteProperty("FileName", m_FileName, m_def_FileName)
    Call PropBag.WriteProperty("RecordState", m_RecordState, m_def_RecordState)
    Call PropBag.WriteProperty("SampleValue", m_SampleValue, m_def_SampleValue)
    '
End Sub
                                                                         
'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    '
    m_MixerLineVolume = m_def_MixerLineVolume
    m_DeviceNumber = m_def_DeviceNumber
    m_DeviceName = m_def_DeviceName
    m_FileName = m_def_FileName
    m_RecordState = m_def_RecordState
    m_SampleValue = m_def_SampleValue
    '
End Sub
                                                                         
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,0,0,500
Public Property Get FileName() As String
    '
    FileName = m_FileName
    '
End Property
                                                                    
Public Property Get SampleValue() As String
    '
    SampleValue = m_SampleValue
    '
End Property
                                                                    
Public Property Let FileName(ByVal New_FileName As String)
    '
    m_FileName = New_FileName
    PropertyChanged "FileName"
    '
End Property
                                                                    
Public Property Get RecordState() As Boolean
    '
    RecordState = m_RecordState
    '
End Property
                                                                    
Public Function InitDevice() As Boolean
    '
    On Error Resume Next
    '
    Set clsRecorder = New WaveInRecorder
    Set clsEncoder = New EncoderWAV
    Set clsDSP = New clsDSP
    '
End Function
                                                                    
Public Function OpenDevice(i As Integer) As Boolean
    '
    On Error Resume Next
    '
    ReDim intSamples(FFT_SAMPLES - 1)
    '
    If Not clsRecorder.SelectDevice(i - 1) Then                                 '选择第一个声卡
        '
        OpenDevice = False
        '
    Else
        '
        clsDSP.samplerate = CLng(16000)
        clsDSP.channels = 1
        clsEncoder.SelectFormatWav
        '
        OpenDevice = True
        '
    End If
    '
End Function
                                                                    
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Public Function CloseDevice()
    '
    On Error Resume Next
    '
    Dim temp As Boolean
    '
    If clsRecorder.IsRecording Then
        '
        temp = StopRecord()
        '
    End If
    '
    Set clsRecorder = Nothing
    Set clsEncoder = Nothing
    Set clsDSP = Nothing
    '
End Function
                                                                    
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Public Function SelectMIC() As Boolean
    '
    On Error Resume Next
    '
    Dim i As Long
    '
    SelectMIC = False
    '
    For i = 0 To clsRecorder.MixerLineCount - 1
        '
        If Not clsRecorder.SelectMixerLine(i) Then
            'MsgBox "Couldn't select !", vbExclamation
        Else
            '
            If clsRecorder.MixerLineType = MIXERLINE_MICROPHONE Then
                '
                SelectMIC = True
                Exit Function
                '
            End If
            '
        End If
        '
    Next
    '
End Function
                                                                    
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Public Function SelectLINE() As Boolean
    '
    On Error Resume Next
    '
    Dim i As Long
    '
    SelectLINE = False
    '
    For i = 0 To clsRecorder.MixerLineCount - 1
        '
        If Not clsRecorder.SelectMixerLine(i) Then
            'MsgBox "Couldn't select !", vbExclamation
        Else
            '
            If clsRecorder.MixerLineType = MIXERLINE_LINE Then
                '
                SelectLINE = True
                Exit Function
                '
            End If
            '
        End If
        '
    Next
    '
End Function
                                                                    
Private Function GetArrayMaxAbs( _
                                intArray() As Integer, _
                                Optional ByVal offStart As Long = 0, _
                                Optional ByVal steps As Long = 1 _
                                ) As Long
    Dim lngTemp As Long
    Dim lngMax  As Long
    Dim i       As Long
    For i = offStart To UBound(intArray) Step steps
        lngTemp = Abs(CLng(intArray(i)))
        If lngTemp > lngMax Then
            lngMax = lngTemp
        End If
    Next
    GetArrayMaxAbs = lngMax
End Function
                                                                    
'
Private Sub clsRecorder_GotData(intBuffer() As Integer, lngLen As Long)
    '
    On Error Resume Next
    '
    Dim temp As Boolean
    '
    intSamples = intBuffer
    clsDSP.ProcessSamples intSamples
    '
    If Not clsRecorder.IsRecording Then Exit Sub
    '
    lngMSEncoded = lngMSEncoded ((lngLen / lngBytesPerSec) * 1000)
    '
    If Not clsEncoder Is Nothing Then
        ' send PCM data to the WAV encoder
        If clsEncoder.Encoder_Encode(VarPtr(intSamples(0)), lngLen, 0) = SND_ERR_WRITE_ERROR Then
            '
            temp = StopRecord()
            '
        End If
        '
    End If
    '
End Sub
                                                                         
'
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Public Function StartRecord(Optional samplerate As Integer = 8000, Optional channels As Integer = 1) As Boolean
    '
    On Error Resume Next
    '
    Dim sndres  As SND_RESULT
    '
    If clsRecorder.IsRecording Then
        '
        StartRecord = False
        '
    Else
        '
        If m_FileName = "" Then
            '
            StartRecord = False
            '
        Else
            '
            lngBytesPerSec = (CLng(samplerate) * 2)
            sndres = clsEncoder.Encoder_EncoderInit(CLng(samplerate), channels, m_FileName)
            If sndres <> SND_ERR_SUCCESS Then
                '
                StartRecord = False
                '
            Else
                '
                'clsDSP.samplerate = CLng(8000)
                'clsDSP.Channels = 1
                'clsEncoder.SelectFormatWav
                '
                If Not clsRecorder.StartRecord(samplerate, channels) Then
                    '
                    StartRecord = False
                    '
                Else
                    '
                    m_SampleValue = 0
                    tmrVis.Enabled = True
                    m_RecordState = True
                    StartRecord = True
                    '
                End If
                '
            End If
            '
        End If
        '
    End If
    '
End Function
                                                                    
'
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Public Function StopRecord() As Boolean
    '
    On Error Resume Next
    '
    If clsRecorder.IsRecording Then
        '
        If Not clsRecorder.StopRecord Then
            '
            StopRecord = False
            '
        Else
            '
            clsEncoder.Encoder_EncoderClose
            lngMSEncoded = 0
            lngBytesPerSec = 0
            '
            m_SampleValue = 0
            tmrVis.Enabled = False
            m_RecordState = False
            StopRecord = True
            '
        End If
        '
    Else
        '
        StopRecord = False
        '
    End If
    '
End Function
                                                                    
Public Sub SetMixerLineVolume(i As Long)
    '
    On Error Resume Next
    '
    If i >= 65535 Then
        '
        i = 65535
        '
    Else
        '
        If i <= 0 Then
            '
            i = 1
            '
        End If
        '
    End If
    '
    clsRecorder.MixerLineVolume = i
    '
End Sub
                                                                         
Public Function DeviceName(i As Integer) As String
    '
    On Error Resume Next
    '
    DeviceName = clsRecorder.DeviceName(i - 1)
    '
End Function
                                                                    
Public Function DeviceNumber() As Long
    '
    On Error Resume Next
    '
    DeviceNumber = clsRecorder.DeviceCount
    '
End Function