Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0407: Aufnahmegerät finden, das zur Aufnahmeeinstellung passt

 von 

Beschreibung 

Dieser Tipp ermöglicht das Finden eines zur Aufnahme bereiten Gerätes, das bestimmten Vorgaben entspricht.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

waveOutGetDevCapsA (waveOutGetDevCaps), waveOutGetNumDevs

Download:

Download des Beispielprojektes [3,06 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 Project1.vbp -------------
'--------- Anfang Formular "Form1" 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: Klaus Langbein
'E-Mail: 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 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

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

Const WAVE_INVALIDFORMAT As Long = &H0& 'invalid format
Const WAVE_FORMAT_1M08 As Long = &H1&   '11.025 kHz,Mono,   8-bit
Const WAVE_FORMAT_1S08 As Long = &H2&   '11.025 kHz,Stereo, 8-bit
Const WAVE_FORMAT_1M16 As Long = &H4&   '11.025 kHz,Mono,  16-bit
Const WAVE_FORMAT_1S16 As Long = &H8&   '11.025 kHz,Stereo,16-bit
Const WAVE_FORMAT_2M08 As Long = &H10&  '22.05  kHz,Mono,   8-bit
Const WAVE_FORMAT_2S08 As Long = &H20&  '22.05  kHz,Stereo, 8-bit
Const WAVE_FORMAT_2M16 As Long = &H40&  '22.05  kHz,Mono,  16-bit
Const WAVE_FORMAT_2S16 As Long = &H80&  '22.05  kHz,Stereo,16-bit
Const WAVE_FORMAT_4M08 As Long = &H100& '44.1   kHz,Mono,   8-bit
Const WAVE_FORMAT_4S08 As Long = &H200& '44.1   kHz,Stereo, 8-bit
Const WAVE_FORMAT_4M16 As Long = &H400& '44.1   kHz,Mono,  16-bit
Const WAVE_FORMAT_4S16 As Long = &H800& '44.1   kHz,Stereo,16-bit
              
Private Function getOptionWavetype() As Long
    Dim i As Integer
    
    For i = 0 To 3
        If optWavtype(i).Value = -1 Then
            getOptionWavetype = i
            Exit Function
        End If
    Next i
End Function

Private Function getSampleRate() As Long
    Dim i As Integer
    
    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 As Long
    Dim Srate As Long
    
    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 Device
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 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.

Kommentar von Peter Krämer am 09.07.2006 um 20:30

ich nutze Office/Excel 2000 und VB6.0.

Wie kann ich da die Projektdatei "Project1.vbp" und das Formular "Form1" alias "Form1.frm" laden?

Mit Datei-Import bekomme ich eine Fehlermeldung, dass die in der Datei "Form1.frm" enthalte Formularklasse von VBE nicht unterstützt wird.

Was kann ich tun?

Kommentar von Peter Krämer am 09.07.2006 um 18:27

der Datentyp "WaveOutCaps" ist im obigen Beispiel zu
waveOutGetDevCapsA (waveOutGetDevCaps) nicht definiert

Kommentar von Tootaa am 30.12.2001 um 14:10

Hallochen, könnt Ihr mir verraten wie ich Midi in WAV umwandelnkann?
Danke