说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

利用VB测声卡

HTML文档下载 WORD文档下载 PDF文档下载
利用VB测声卡
在一个多媒体应用程序中,如果涉及对声音的播 放与操作,那么我们就有必要先对用户系统中的声卡 及真功能进行一下测试。幸好有VB,所以我们要实现 这些功能并不用费多大力气(也就是吃顿饭的力气), 在下面的程序中我们将利用VB调用两个windows Api函数--Waveoutgetnumdevs()和Waveoutgetdev- capS()来访问设备驱动程序,获取有关信息,实现上述 目的。OK,Let's Go! 一、我们先要捡测一下声卡是否存在
1.新建一工程并添加模块Module1.bas,在其声 明部分加入如下代码:
Declare Function Waveoutgetnumdevs Lib"Winmm.Dll"() as Long
Public Const Mb_ok= & H40
2.在窗体上添加一个命令按钮cmdtest,设置Caption的属性为“测试声卡”
3.在窗体的通用声明部分加入一函数testcard,代码如下:
Public Function Testcard() As Boolean
Dim Y As long
Dim Find As String Find = “Fied Sound Blaster Card"
Y = Waveoutgetnumdevs()
If Y > 0 Then
Testcard = True
Msgbox "啥啥,我找到你了--声卡!", Mb_ok,Find
Else
Testcard = Falsc
Msgbox "未发现设备",Mb_ok,Find
End if
End Function
4.在命令按钮的单击事件中加入代码:
Private sub Cmdtest_Click()
Dim Existent As Boolean
Existent =Testcard
End sub
现在你可以运行这个程序试试看了,它会检测你 的系统中是否有声卡的存在。 二、测试声卡的功能
既然已经发现了声卡的存在,接下来就要测试一 下它的功能。为什么?举个例子来说,老式声卡支持的 采样率和位分辨率是远不及现在声卡的,如果你试图 用只有8位分辨率和22.05KHz采样率的声卡来播放 44.1KHz、16位立体声的声音文件,嘿嘿……有你好 看(其实也没啥大不了的)。好,你大胆的往下看。
1.在窗体上加入picturebox控件picture1。
2.在Module1.bass的声名节中加入代码:
Declare Function Waveoutgetdevcaps Lib "Winmm.dll" Alias"Waveoutgetdevcapsa"(ByvaI Udcviceid As Long,Lpcaps As WaveOutcaps, ByvaI Usize As Long) As Long
'参数1指定被测设备。由于一台PC上装有几个音频设 备是完全可能的,所以Windows自动给每个设备编号,第一 个可用设备号为0。
'参数2是一个Waveoutcaps结构的指针。
'多数3是第二个参数的大小。
Public Const Maxpnamelen = 32
Public Const Wave_Format_1m08 = & H1
Public Const Wavp_Format_1ml6 = & H4
Public Const Wave_Format_1s08 = & H2
Public Const Wave_Format_1sl6 = & H8
Public Const Wavc_Format_2m0B = & H1O
Public Const Wave_Format_2m16 = & H40
Public Const Wave_Format_2s08 = & H20
Public Const Wave_Format_2s16 = & H80
Public Const Wave_Format_4m08 = & H100
Public Const Wave_Format_4ml6 = & H400
Public Const Wave_Format_4s08 = & H200
Public Const Wave_Format_4s16 = & H800
Public Const Wavecaps_Lrvolume = & H8
Public Const Wavecaps_Pitch = & H1
Public Const Wavecaps_Playbackrate = & H2
Public Const Wavecaps_Sync = & H10
Public Const Wavecaps_Volume = & H4

Type WaveoutCaps
Wmid As Integer '设备驱动程序厂商标识
Wpid As Integer '声卡厂商标识
Vdriverversion As Long '驱动程序版本号,高字节为主版 本号,低字节为次版本号
Szpname As String * Maxpnamelen '产品名称
Dwformats As Long '支持的wave格式,每一位代表一 种格式
Wchannels As Integer '返回整型值1(单声道)或2(立体 声)
Dwsupport As Long '设备支持的扩展输出功能
End Type
3. 在窗体的声明节内增加两个函数:
'函数 listwaveformat 检测波形音频支持的格式
Public Function Listwaveformat(Aboutwave As long) As String
Dim Waveformat As String
Select Case Aboutwave
Case Wave_Format_1m08
Waveformat = "11.025khz, Mono, 8bit, 11kb/Ps"
Case Wave_Format_1m16
Waveformat = "11.025khz, Mono, 16bit, 22kb/Ps"
Case Wave_Format_1s08
Waveformat = "11.025khz, Stereo, 8bit, 22kb/Ps"
Case Wave_Format_1s16
Waveformat = "11.025khz, Stereo, 16bit, 43kb/Ps"
Case wave_Format_2m08
Waveformat = "22.05khz, Mono, 8bit, 22kb/Ps"
Case Wavc_Format_2m16
Waveformat = "22.05khz. Mono,16bit, 43kb/Ps"
Case Wave_Format_2s16
Waveformat = "22.05khz, Stereo, 8bit, 43kb/Ps"
Case Wave_Format_2s16
Waveformat = "22.05khz, Stereo, 16bit, 86kb/Ps"
Case Wave_Format_4m08
Waveformat = "44.1khz, Mono, 8bit, 43kb/Ps"
Case Wave_Format_4m16
Wavcformat = "44.lkhz, Mono, 16bit, 86KB/Ps"
Case Wave_Format_4s08
Waveformat = "44.lkhz, Stereo, 8bit, 86kb/Ps"
Case Wavc_Format_4s16
Waveformat = "44.lkhz. Stereo, 16bit, 172kb/Ps"
End Select
Listwaveformat = Waveformat
End Function
'函数 Listwavesupport 检测设备支持的扩展输出功能
Public Function Listwavesupport(Aboutwave As long) As String
Dim Wavefun As String
Sclect Case Aboutwave
Case Wavecaps_Pitch
Wavefun = "Support Pitch"
Casc Wavecaps_Playbackrate
Wavefun = "Support Playback"
Case Wavecaps_Volume
Wavefun = "Support Volume Control"
Csae Wavecaps_Lrvolume
Wavefun = "Support Left - Right Channals"
Csae Wavecaps_sync
Wavcfun = "Support Synchronization"
End Select
Listwavesupport = Wavefun
End Function
4. 修改 cmdtest_Click 事件的代码为:
Private Sub Cmdtest_Click()
Dim Existent As Boolean
Dim Consequence As long
Dim Returncaps As Waveoutcaps
Dim Rainver As Long
Dim Lesservcr As long
Dim Pname As String * 32
Dim Aboutwave As long
Dim Channel As String * 2
Dim I As lnteger
Existent = Testcard
If Existent Then
Consequence = Waveoutgetdevcaps(0, Returncaps, Len (Returncaps)) If Consequence = 0 Then
Mainver = Returncaps.Vdriverversion \ 256
Lesserver = Returncaps.Vdriverversion Mod 256
'因为API在返回Returncaps.szpname 时在返回值与空格之 间会插入一个空的终止符,用Rtrim$会返回一个0终止字符 串,所以我们采用Instr+Left$的方法.
Pname = Left$ (Returncaps.Szpname,Instr(Returncaps .Szpname, Chrr$(0))-1)
Channe1 = Str$ (Returncaps.Wchannels)
Picture1.Print "产品名称:"; Pname
Picture1.Print "产品 Id:"; Returncaps.Wpid
Picture1.Print "驱动程序 Id:"; Returncaps.Wrmid
Picture1.Print "驱动程序版本:"; Mainver; "."; Lesserver Picture1.Print "输出声道:"; Channel
Picture1.Print "支持格式列表:"
For I = 0 TO 11
If Returncaps.Dwformats And (2^I) Then
Picture1.Print Listwaveformat (2^I)
End if
Next I
Picture1.Print "扩展输出功能列表:"
For l = 0 To 4
If Returncaps.Dwsupport And (2^I) Then
Picture1.Print Listwavesupport(2^I)
End if
Next I
End if
Else
End
End if
End Sub
5. 为 Form_load 事件加入 代码:
Private Sub Form_Load() Picture1.Cls End Sub 本程序在Win95(osr2)、 VB5企业版下调试通过,在 win3.2 下仅仅两个API函数 略有改变,照猫画虎即可。
好了,工作已经全部做完了。现在你要做的只是按下 F5.
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘