form1.frm

Visual.Basic.NET实用编程百例-47.6M.zip

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "测试声卡"
   ClientHeight    =   5775
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5775
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Text1 
      Height          =   5055
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   120
      Width           =   4455
   End
   Begin VB.CommandButton CmdTest 
      Caption         =   "测试声卡"
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Top             =   5280
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function waveOutGetNumDevs Lib "Winmm.dll" () As Long
Private Declare Function waveOutGetDevCaps Lib "Winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As Waveoutcaps, ByVal uSize As Long) As Long

Private Const Mb_OK = &H0
Private Const Maxpnamelen = 32
Private Const Wave_Format_1m08 = &H1
Private Const Wave_Format_1m16 = &H4
Private Const Wave_Format_1s08 = &H2
Private Const Wave_Format_1s16 = &H8
Private Const Wave_Format_2m08 = &H10
Private Const Wave_Format_2m16 = &H40
Private Const Wave_Format_2s08 = &H20
Private Const Wave_Format_2s16 = &H80
Private Const Wave_Format_4m08 = &H100
Private Const Wave_Format_4m16 = &H400
Private Const Wave_Format_4s08 = &H200
Private Const Wave_Format_4s16 = &H800
Private Const Wavecaps_Lrvolume = &H8
Private Const Wavecaps_Pitch = &H1
Private Const Wavecaps_Playbackrate = &H2
Private Const Wavecaps_Sync = &H10
Private Const Wavecaps_Volume = &H4

Private Type Waveoutcaps
    Wmid As Integer
    Wpid As Integer
    Vdriverversion As Long
    Szpname As String * Maxpnamelen
    Dwformats As Long
    Wchannels As Integer
    Dwsupport As Long
End Type

'  测试是否存在声卡
Private 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

'  判断声卡支持的声音格式
Private 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

'  获得声卡的支持的输出功能列表
Private 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
    
    Text1.Text = ""
    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)
            Text1.Text = "产品名称：" & Pname & vbCrLf
            Text1.Text = Text1.Text & "产品 Id：" & Returncaps.Wpid & vbCrLf
            Text1.Text = Text1.Text & "驱动程序 Id：" & Returncaps.Wmid & vbCrLf
            Text1.Text = Text1.Text & "驱动程序版本：" & Mainver & "." & Lesserver & vbCrLf
            Text1.Text = Text1.Text & "输出声道：" & Channel & vbCrLf
            Text1.Text = Text1.Text & "支持格式列表：" & vbCrLf
            For I = 0 To 11
                If Returncaps.Dwformats And (2 ^ I) Then
                    Text1.Text = Text1.Text & Listwaveformat(2 ^ I) & vbCrLf
                End If
            Next I
            Text1.Text = Text1.Text & "扩展输出功能列表："
            For I = 0 To 4
                If Returncaps.Dwsupport And (2 ^ I) Then
                    Text1.Text = Text1.Text & Listwavesupport(2 ^ I) & vbCrLf
                End If
            Next I
         End If
    Else
        End
    End If
End Sub

Private Sub Form_Load()
    Text1.Text = ""
End Sub