Beschreibung: Deklaration: Declare Function auxGetDevCaps Lib "winmm.dll" _ Alias "auxGetDevCapsA" ( _ Byval uDeviceID As Long, _ lpCaps As AUXCAPS, _ Byval uSize As Long) As Long Parameter:
Konstanten: Const AUX_MAPPER = -1& ' AuxMapper Konstante Rückgabewert: Const MMSYSERRR_NOERROR = 0 ' Kein Fehler Const MMSYSERR_BASE = 0 ' Basis Konstante Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE+ 2) ' Falscher Geräte ID Beispiel: Private Declare Function auxGetDevCaps Lib "winmm.dll" _ Alias "auxGetDevCapsA" ( _ ByVal uDeviceID As Long, _ lpCaps As AUXCAPS, _ ByVal uSize As Long) As Long ' Anzahl Geräte Private Declare Function auxGetNumDevs Lib "winmm.dll" () As Long ' auxGetDevCpas (uDevicID) Private Const AUX_MAPPER = -1& ' auxGetDevCaps Rückgabe Private Const MMSYSERR_BASE = 0 Private Const MMSYSERR_NOERROR = 0 Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE+ 2) ' AUXCAPS.szPname Private Const MAXPNAMELEN = 32 ' AUXCAPS.wTechnology Private Const AUXCAPS_AUXIN = &H2 Private Const AUXCAPS_CDAUDIO = &H1 Private Const AUXCAPS_MASTER = &H8 Private Const AUXCAPS_MIC = &H4 Private Const AUXCAPS_MIDI = &H40 Private Const AUXCAPS_PCSPEAKER = &H10 Private Const AUXCAPS_WAVE = &H20 ' AUXCAPS.dwSupport Private Const AUXCAPS_LRVOLUME = &H2 Private Const AUXCAPS_VOLUME = &H1 ' AUXCAPS.wMid Private Const MM_ANTEX = 31 Private Const MM_APPS = 42 Private Const MM_APT = 56 Private Const MM_ARTISOFT = 20 Private Const MM_AST = 64 Private Const MM_ATI = 27 ' ... und so weiter, für Details siehe AUXCAPS Struktur Deklaration ' auxGetDevCaps lpCaps Private Type AUXCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * MAXPNAMELEN wTechnology As Integer dwSupport As Long End Type Private Sub Command1_Click () Dim GerätInfo As AUXCAPS, RetVal As Long RetVal = auxGetDevCaps (AUX_MAPPER, GerätInfo, _ Len(GerätInfo)) If RetVal = MMSYSERR_NOERROR Then PrintInDebugWindow GerätInfo, AUX_MAPPER ElseIf RetVal = MMSYSERR_BADDEVICEID Then Debug.Print "Es is kein Aux Mapper Installiert." End If If auxGetNumDevs = 0 Then Debug.Print "Es sind keine weiteren Audiogeräte Installiert." Exit Sub End If For i = 0 To auxGetNumDevs - 1 RetVal = auxGetDevCaps (i, GerätInfo, Len(GerätInfo)) PrintInDebugWindow GerätInfo, i Next i End Sub Private Function PrintInDebugWindow (ByRef Gerät As AUXCAPS, _ ByVal DeviceIndex As Integer ) Dim MajorVer As Long , MinorVer As Long Debug.Print "Geräte Index: " & DeviceIndex Debug.Print "Geräte Name: " & Left$(Gerät.szPname, _ InStr(1, Gerät.szPname, vbNullChar) - 1) Debug.Print "Geräte Hersteller: " & GetManufacturerName(Gerät.wMid) MajorVer = ( Gerät.vDriverVersion And &HFF00) / &H100 MinorVer = Gerät.vDriverVersion And &HFF Debug.Print "Treiber Version: " & MajorVer & "." & MinorVer If Gerät.dwSupport = (AUXCAPS_LRVOLUME And AUXCAPS_VOLUME) Then Debug.Print "Kanäle: 2 (Stereo)" ElseIf Gerät.dwSupport = AUXCAPS_VOLUME Then Debug.Print "Kanäle: 1 (Mono)" End If Select Case Gerät.wTechnology Case AUXCAPS_AUXIN Debug.Print "Gerätetyp: AUX IN" Case AUXCAPS_CDAUDIO Debug.Print "Gerätetyp: Audio CD" Case AUXCAPS_MASTER Debug.Print "Gerätetyp: Master" Case AUXCAPS_MIC Debug.Print "Gerätetyp: Microfon" Case AUXCAPS_MIDI Debug.Print "Gerätetyp: Midi" Case AUXCAPS_PCSPEAKER Debug.Print "Gerätetyp: PC Lautsprecher" Case AUXCAPS_WAVE Debug.Print "Gerätetyp: Wave" Case Else Debug.Print "Gerätetyp: Unbekannt" End Select Debug.Print vbCrLf End Function Private Function GetManufacturerName(ByVal _ ManufacturerID As Integer ) As String Select Case ManufacturerID Case MM_ANTEX GetManufacturerName = "Antex Electronics Corporation" Case MM_APPS GetManufacturerName = "APPS Software" Case MM_ARTISOFT GetManufacturerName = "Artisoft, Inc." Case MM_AST GetManufacturerName = "AST Research, Inc." Case MM_ATI GetManufacturerName = "ATI Technologies, Inc." ' ... und so weiter, für Details siehe AUXCAPS Struktur Deklaration Case Else GetManufacturerName = "Unbekannt (ID=" & ManufacturerID & ")" End Select End Function Diese Seite wurde bereits 16.553 mal aufgerufen. |
Access-Tools Vol.1 ![]() Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB Buchempfehlung Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. Neu! sevDTA 3.0 Pro ![]() SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |