form1.vb

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

Friend Class Form1
    Inherits System.Windows.Forms.Form
#Region "Windows 窗体设计器生成的代码"
    Public Sub New()
        MyBase.New()
        '此调用是 Windows 窗体设计器所必需的。
        InitializeComponent()
    End Sub
    '窗体重写处置，以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
        If Disposing Then
            If Not components Is Nothing Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(Disposing)
    End Sub
    'Windows 窗体设计器所必需的
    Private components As System.ComponentModel.IContainer
    Public ToolTip1 As System.Windows.Forms.ToolTip
    Public WithEvents TextBox1 As System.Windows.Forms.TextBox
    Public WithEvents Button1 As System.Windows.Forms.Button
    '注意: 以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器来修改它。
    '不要使用代码编辑器修改它。
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Me.ToolTip1 = New System.Windows.Forms.ToolTip(Me.components)
        Me.TextBox1 = New System.Windows.Forms.TextBox
        Me.Button1 = New System.Windows.Forms.Button
        Me.SuspendLayout()
        '
        'TextBox1
        '
        Me.TextBox1.AcceptsReturn = True
        Me.TextBox1.AutoSize = False
        Me.TextBox1.BackColor = System.Drawing.SystemColors.Window
        Me.TextBox1.Cursor = System.Windows.Forms.Cursors.IBeam
        Me.TextBox1.ForeColor = System.Drawing.SystemColors.WindowText
        Me.TextBox1.Location = New System.Drawing.Point(8, 8)
        Me.TextBox1.MaxLength = 0
        Me.TextBox1.Multiline = True
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.TextBox1.Size = New System.Drawing.Size(297, 208)
        Me.TextBox1.TabIndex = 1
        Me.TextBox1.Text = ""
        '
        'Button1
        '
        Me.Button1.BackColor = System.Drawing.SystemColors.Control
        Me.Button1.Cursor = System.Windows.Forms.Cursors.Default
        Me.Button1.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Button1.Location = New System.Drawing.Point(96, 232)
        Me.Button1.Name = "Button1"
        Me.Button1.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Button1.Size = New System.Drawing.Size(89, 25)
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "检测声卡"
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.BackColor = System.Drawing.SystemColors.Control
        Me.ClientSize = New System.Drawing.Size(312, 269)
        Me.Controls.Add(Me.TextBox1)
        Me.Controls.Add(Me.Button1)
        Me.Cursor = System.Windows.Forms.Cursors.Default
        Me.Location = New System.Drawing.Point(4, 23)
        Me.Name = "Form1"
        Me.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "检测声卡"
        Me.ResumeLayout(False)

    End Sub
#End Region
    '  测试是否存在声卡
    Private Function TestCard() As Boolean
        Dim Y As Integer
        Dim Find As String

        Find = "寻找声卡"
        Y = waveOutGetNumDevs()
        If Y > 0 Then
            TestCard = True
            MsgBox("找到声卡", Mb_OK, Find)
        Else
            TestCard = False
            MsgBox("没有找到声卡！", Mb_OK, Find)
        End If
    End Function

    '  判断声卡支持的声音格式
    Private Function Listwaveformat(ByRef Aboutwave As Integer) 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(ByRef Aboutwave As Integer) 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 Button1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Button1.Click
        Dim Consequence As Object
        Dim Existent As Boolean
        Dim Consequencd As Integer
        Dim Returncaps As Waveoutcaps
        Dim Mainver As Integer
        Dim Lesserver As Integer
        Dim Pname As New VB6.FixedLengthString(32)
        Dim Aboutwave As Integer
        Dim Channel As New VB6.FixedLengthString(2)
        Dim I As Short

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

    Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        TextBox1.Text = ""
    End Sub
End Class