form1.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3708
   ClientLeft      =   48
   ClientTop       =   348
   ClientWidth     =   4380
   LinkTopic       =   "Form1"
   ScaleHeight     =   3708
   ScaleWidth      =   4380
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   612
      Left            =   1320
      TabIndex        =   1
      Top             =   3000
      Width           =   1332
   End
   Begin VB.PictureBox Picture1 
      Height          =   2772
      Left            =   240
      ScaleHeight     =   2724
      ScaleWidth      =   3804
      TabIndex        =   0
      Top             =   120
      Width           =   3852
   End
End
Attribute VB_Name = "Form1"
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
    
    Y = waveOutGetNumDevs()
    If Y > 0 Then
        TestCard = True
        MsgBox "检测成功！", vbOKOnly, "检测完成"
    Else
        TestCard = False
        MsgBox "sorry,no soundcard!", vbOKOnly, "checkout"
    End If
    
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 "
        Case Wavecaps_Lrvolume
            Wavefun = "Support LR"
        Case Wavecaps_Sync
            Wavefun = "Support Synchronization"
    End Select
    Listwavesupport = Wavefun
End Function

Private Sub Command1_Click()
    Dim Conse 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
    
    If TestCard Then
        Conse = waveOutGetDevCaps(0, Returncaps, Len(Returncaps))
        
        If Conse = MMSYSERR_NOERROR Then
            Mainver = Returncaps.Vdrivervesion \ 256
            Lesserver = Returncaps.Vdrivervesion Mod 256
            Pname = Left$(Returncaps.Szpname, InStr(Returncaps.Szpname, Chr$(0)) - 1)
            Channel = Str$(Returncaps.Wchannels)
            
            Picture1.Print "name:"; Pname
            Picture1.Print "ID:"; Returncaps.Wpid
            Picture1.Print "驱动程序"; Returncaps.Wmid
            Picture1.Print "驱动程序版本"; Mainver; "."; Lesserver
            Picture1.Print "输出声道:"; Channel
            
            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
    End If
            
End Sub