实例介绍
【实例简介】
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
相关软件
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论