Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0510: Auslesen der verfügbaren Soundeinstellungen

VB 5/6-Tipp 0510: Auslesen der verfügbaren Soundeinstellungen

 von Klaus Langbein

Schwierigkeitsgrad:

Verwendete API-Aufrufe: waveOutGetDevCapsA (waveOutGetDevCaps), waveOutGetNumDevs

Download: Download des Beispielprojektes [2,89 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei getCaps.vbp  -------------
'------- Anfang Formular "frmDevice" alias Form1.frm  -------
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Optionsfeld-Steuerelement "optSample" (Index von 0 bis 2) auf Frame1
' Steuerelement: Rahmensteuerelement "frmStereo"
' Steuerelement: Optionsfeld-Steuerelement "optWavtype" (Index von 0 bis 3) auf frmStereo
' Steuerelement: Listen-Steuerelement "lstDevice"
' Steuerelement: Schaltfläche "cmdGet"


' Autor: K. Langbein Klaus@ActiveVB.de
' Dieses Programm wurde auf der Grundlage der
' Vorarbeiten von Murphy McCauley erstellt
'-----------------------------------------------------------------
' Murphy McCauley (MurphyMc@Concentric.NET) 08/14/99
' http://www.fullspectrum.com/deeth/
'-----------------------------------------------------------------
Option Explicit


Private Type WaveOutCaps
    ManufacturerID As Integer
    ProductID As Integer
    DriverVersion As Long
    ProductName(1 To 32) As Byte
    Formats As Long
    Channels As Integer
    dwSupport As Long
End Type

Private Const WAVE_INVALIDFORMAT = &H0&   ' ungueltiges format
Private Const WAVE_FORMAT_1M08 = &H1&     ' 11.025 kHz, Mono,   8-bit
Private Const WAVE_FORMAT_1S08 = &H2&     ' 11.025 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_1M16 = &H4&     ' 11.025 kHz, Mono,   16-bit
Private Const WAVE_FORMAT_1S16 = &H8&     ' 11.025 kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_2M08 = &H10&    ' 22.05  kHz, Mono,   8-bit
Private Const WAVE_FORMAT_2S08 = &H20&    ' 22.05  kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_2M16 = &H40&    ' 22.05  kHz, Mono,   16-bit
Private Const WAVE_FORMAT_2S16 = &H80&    ' 22.05  kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_4M08 = &H100&   ' 44.1   kHz, Mono,   8-bit
Private Const WAVE_FORMAT_4S08 = &H200&   ' 44.1   kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_4M16 = &H400&   ' 44.1   kHz, Mono,   16-bit
Private Const WAVE_FORMAT_4S16 = &H800&   ' 44.1   kHz, Stereo, 16-bit

Private Declare Function waveOutGetDevCaps Lib "winmm.dll" _
                Alias "waveOutGetDevCapsA" (ByVal uDeviceID _
                As Long, lpCaps As WaveOutCaps, _
                ByVal uSize As Long) As Long
               
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Function getOptionWavetype()

Dim i

    For i = 0 To 3
        If optWavtype(i).Value = -1 Then
            getOptionWavetype = i
            Exit Function
        End If
    Next i

End Function
Function getSampleRate()

Dim i

    For i = 0 To 2
        If optSample(i).Value = -1 Then
            getSampleRate = Val(optSample(i).Caption)
            Exit Function
        End If
    Next i

End Function

Private Sub cmdGet_Click()

    Dim wavetype As Long
    Dim wtype
    Dim srate
    
    lstDevice.Clear
    wtype = getOptionWavetype
    srate = getSampleRate
    
    
    Select Case srate
    Case 11025
        Select Case wtype
        
        Case 0
            wavetype = WAVE_FORMAT_1M08
        Case 1
            wavetype = WAVE_FORMAT_1S08
        Case 2
            wavetype = WAVE_FORMAT_1M16
        Case 3
            wavetype = WAVE_FORMAT_1S16
        End Select
    
    Case 22050
        Select Case wtype
        
        Case 0
            wavetype = WAVE_FORMAT_2M08
        Case 1
            wavetype = WAVE_FORMAT_2S08
        Case 2
            wavetype = WAVE_FORMAT_2M16
        Case 3
            wavetype = WAVE_FORMAT_2S16
        End Select
    
    Case 44100
        Select Case wtype
        
        Case 0
            wavetype = WAVE_FORMAT_4M08
        Case 1
            wavetype = WAVE_FORMAT_4S08
        Case 2
            wavetype = WAVE_FORMAT_4M16
        Case 3
            wavetype = WAVE_FORMAT_4S16
        End Select
        
    End Select
    
    
    Call FindCompatibleDevice(wavetype)
    
End Sub

Private Sub FindCompatibleDevice(DeviceFormat As Long)
    
    
    Dim Caps As WaveOutCaps
    Dim Device As Long

    For Device = 0 To waveOutGetNumDevs - 1
        Call waveOutGetDevCaps(Device, Caps, Len(Caps))
        If (Caps.Formats And DeviceFormat) Then
            lstDevice.AddItem StrConv(Caps.ProductName, vbUnicode)
        End If
    Next
  
    
End Sub
'-------- Ende Formular "frmDevice" alias Form1.frm  --------
'-------------- Ende Projektdatei getCaps.vbp  --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.