庞大资源库的计算机教程网站!
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]
首页 操作系统 程序设计 图形图像 媒体动画 机械电子 WEB开发 数 据 库 办公系列 路由技术 网络原理 网络应用
认证考试 安全技术
首页>程序设计>VB专区>编程技巧>正文
资料搜索
Google搜索
Google
返回上级列表

推荐文章

快速保存网页中所有图片的方法
Windows中让光驱巧妙“隐身”技
防范非法用户入侵Win 2000/XP系
两款比较典型的ASP木马防范方法
有关表格边框的css语法整理
Windows XP中可以被禁用的服务
SQL Server导出导入数据方法
Javascript所有对象的属性的获
网页(HTML)中的特殊字符
与篮球共舞,尽显模式本色
QQ病毒的手工清除方法
Photoshop为极品美女打造性感睫
天衣无缝:IIS与PHP水火也相容
SQL Server存储过程编写和优化

利用VB测声卡

 作者:本站收集   日期:2005-8-4 11:34:16
字号选择〖 〗/ 双击滚屏 单击停止   
在一个多媒体应用程序中,如果涉及对声音的播 放与操作,那么我们就有必要先对用户系统中的声卡 及真功能进行一下测试。幸好有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,我也要随风而去了,各位看官后会有期,隐也。
上一篇:编制自已的电话录音小程序    下一篇:在VB应用软件中实现动画效果  
[发送给好友]  [关闭窗口]  [返回顶部]   转载请注明来源:www.it00.com   
特别声明: 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载,但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站,我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员,我们尽快予以更正。
责任编辑: 原点 投稿作者: 本站收集
信息来源: 网络 录入时间: 2005-8-4 11:34:16
关于我们 - 广告服务 - 版权申明 - 网站地图 - 联系方式 - 总编信箱 - 会员投稿