form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form form1 
   Caption         =   "测试声卡"
   ClientHeight    =   3120
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3645
   LinkTopic       =   "Form1"
   ScaleHeight     =   3120
   ScaleWidth      =   3645
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   2040
      TabIndex        =   2
      Top             =   2670
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      Height          =   2565
      Left            =   15
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   30
      Width           =   3585
   End
   Begin VB.CommandButton Command1 
      Caption         =   "测试声卡"
      Height          =   375
      Left            =   720
      TabIndex        =   0
      Top             =   2670
      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
 
 Const Mb_OK = &H0
 Const Maxpnamelen = 32
 Const Wave_Format_1m08 = &H1
 Const Wave_Format_1m16 = &H4
 Const Wave_Format_1s08 = &H2
 Const Wave_Format_1s16 = &H8
 Const Wave_Format_2m08 = &H10
 Const Wave_Format_2m16 = &H40
 Const Wave_Format_2s08 = &H20
 Const Wave_Format_2s16 = &H80
 Const Wave_Format_4m08 = &H100
 Const Wave_Format_4m16 = &H400
 Const Wave_Format_4s08 = &H200
 Const Wave_Format_4s16 = &H800
 Const Wavecaps_Lrvolume = &H8
 Const Wavecaps_Pitch = &H1
 Const Wavecaps_Playbackrate = &H2
 Const Wavecaps_Sync = &H10
 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 Sub Command1_Click()       '测试声卡
  Dim wave1, wave2, Mainversion As String
  Dim Pname, Channel As String
  Dim wavinf, lesser As Long
  Dim Returncaps As Waveoutcaps
  Dim I As Integer
  Dim Y As Long
  Y = waveOutGetNumDevs()         '监测有无声卡
  If Y > 0 Then
     wavinf = waveOutGetDevCaps(0, Returncaps, Len(Returncaps)) '获取声卡信息
     If wavinf = 0 Then
        Mainversion = Returncaps.Vdriverversion \ 256
        lesser = 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 & "驱动程序版本：" & Mainversion & "." & lesser & vbCrLf
        Text1.Text = Text1.Text & "输出声道：" & Channel & vbCrLf
        Text1.Text = Text1.Text & "支持格式列表：" & vbCrLf
        Text1.Text = Text1.Text & "输出声道：" & Channel & vbCrLf
        Text1.Text = Text1.Text & "扩展输出功能列表：" & vbCrLf
        For I = 0 To 11
          If Returncaps.Dwformats And (2 ^ I) Then    '列举声卡支持格式
              Select Case 2 ^ I
                Case Wave_Format_1m08
                    wave1 = "11.025Khz,Mono,8bit,11Kb/Ps"
                Case Wave_Format_1m16
                    wave1 = "11.025Khz,Mono,16bit,22Kb/Ps"
                Case Wave_Format_1s08
                    wave1 = "11.025Khz,Stereo,8bit,22Kb/Ps"
                Case Wave_Format_1s16
                    wave1 = "11.025Khz,Stereo,16bit,43Kb/Ps"
                Case Wave_Format_2m08
                    wave1 = "22.05Khz,Mono,8bit,22Kb/Ps"
                Case Wave_Format_2m16
                    wave1 = "22.05Khz,Mono,16bit,43Kb/Ps"
                Case Wave_Format_2s08
                    wave1 = "22.05Khz,Stereo,8bit,43Kb/Ps"
                Case Wave_Format_2s16
                    wave1 = "22.05Khz,Stereo,16bit,86Kb/Ps"
                Case Wave_Format_4m08
                    wave1 = "44.1Khz,Mono,8bit,43Kb/Ps"
                Case Wave_Format_4m16
                    wave1 = "44.1Khz,Mono,16bit,86Kb/Ps"
                Case Wave_Format_4s08
                    wave1 = "44.1Khz,Stereo,8bit,86Kb/Ps"
                Case Wave_Format_4s16
                    wave1 = "44.1Khz,Stereo,16bit,172Kb/Ps"
              End Select
          
             Text1.Text = Text1.Text & wave1 & vbCrLf
          End If
        Next I
        For I = 0 To 4
          If Returncaps.Dwsupport And (2 ^ I) Then  '列举声卡扩展功能
                 Select Case 2 ^ I
                    Case Wavecaps_Pitch
                        wave2 = "Support Pitch"
                    Case Wavecaps_Playbackrate
                        wave2 = "Support Playback"
                    Case Wavecaps_Volume
                        wave2 = "Support Volume Control"
                    Case Wavecaps_Lrvolume
                        wave2 = "Support Left-Right Channals"
                    Case Wavecaps_Sync
                        wave2 = "Support Synchronization"
                  End Select
             Text1.Text = Text1.Text & wave2 & vbCrLf
           End If
        Next I
       End If
     Else
       Text1.Text = "您的计算机无声卡设备"
  End If
End Sub

Private Sub Command2_Click()
  End
End Sub