soundcard.frm

一款漂亮的控件。 快

VERSION 5.00
Begin VB.Form frmSoundCard 
   Caption         =   "测试声卡"
   ClientHeight    =   4890
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4890
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      Height          =   4000
      Left            =   240
      ScaleHeight     =   3945
      ScaleWidth      =   4035
      TabIndex        =   1
      Top             =   240
      Width           =   4095
   End
   Begin VB.CommandButton CmdTest 
      Caption         =   "测试声卡"
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Top             =   4440
      Width           =   1335
   End
End
Attribute VB_Name = "frmSoundCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Public Function TestCard() As Boolean
Dim Y As Long
Dim Find As String
Find = "Find Sound Blaster Card"
Y = waveOutGetNumDevs()
If Y > 0 Then
TestCard = True
MsgBox "Test OK!,I can found Sound Blaster Card!", Mb_OK, Find
Else
TestCard = False
MsgBox "No found device", Mb_OK, Find
End If
End Function
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 Wave_Format_2m16
        Waveformat = "22.05Khz,Mono,16bit,43Kb/Ps"
    Case Wave_Format_2s08
        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
        Waveformat = "44.1Khz,Mono,16bit,86Kb/Ps"
    Case Wave_Format_4s08
        Waveformat = "44.1Khz,Stereo,8bit,86Kb/Ps"
    Case Wave_Format_4s16
        Waveformat = "44.1Khz,Stereo,16bit,172Kb/Ps"
End Select
Listwaveformat = Waveformat
End Function
Public Function Listwavesupport(Aboutwave As Long) As String
Dim Wavefun As String
Select Case Aboutwave
    Case Wavecaps_Pitch
        Wavefun = "Support Pitch"
    Case Wavecaps_Playbackrate
        Wavefun = "Support Playback"
    Case Wavecaps_Volume
        Wavefun = "Support Volume Control"
    Case Wavecaps_Lrvolume
        Wavefun = "Support Left-Right Channals"
    Case Wavecaps_Sync
        Wavefun = "Support Synchronization"
End Select
Listwavesupport = Wavefun
End Function
Private Sub CmdTest_Click()
Dim Existent As Boolean
Dim Consequencd As Long
Dim Returncaps As Waveoutcaps
Dim Mainver As Long
Dim Lesserver As Long
Dim Pname As String * 32
Dim Aboutwave As Long
Dim Channel As String * 2
Dim I As Integer
Picture1.Cls
Existent = TestCard
   If Existent Then
    Consequence = waveOutGetDevCaps(0, Returncaps, Len(Returncaps))
   If Consequencd = 0 Then
    Mainver = Returncaps.Vdriverversion \ 256
    Lesserver = Returncaps.Vdriverversion Mod 256
Pname = Left$(Returncaps.Szpname, InStr(Returncaps.Szpname, Chr$(0)) - 1)
    Channel = Str$(Returncaps.Wchannels)
    Picture1.Print "产品名称："; Pname
    Picture1.Print "产品 Id："; Returncaps.Wpid
    Picture1.Print "驱动程序 Id："; Returncaps.Wmid
    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 I = 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

Private Sub Form_Load()
    Picture1.Cls
End Sub