Dieser Tipp zeigt, wie man die Namen aller installierten Audiogeräte auslesen kann. Außerdem zeigen wir Ihnen, wie Sie die eingestellte Lautstärke ermitteln und ändern können. ' zunächst die benötigten API-Deklarationen Private Declare Function auxGetDevCaps Lib "winmm.dll" _ Alias "auxGetDevCapsA" ( _ ByVal uDeviceID As Long, _ lpCaps As AUXCAPS, _ ByVal uSize As Long) As Long Private Declare Function auxGetVolume Lib "winmm.dll" ( _ ByVal uDeviceID As Long, _ ByRef lpdwVolume As Long) As Long Private Declare Function auxSetVolume Lib "winmm.dll" ( _ ByVal uDeviceID As Long, _ ByVal dwVolume As Long) As Long Private Declare Function auxGetNumDevs Lib "winmm.dll" () As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) Const MMSYSERR_BASE = 0 ' DeviceID wurde nicht gefunden Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2) ' Funktion wird nicht unterstützt Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8) ' Kein Fehler Const MMSYSERR_NOERROR = 0 ' Treiber-Aktivierung fehlgeschlagen Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3) ' AUXCAPS.dwSupport enthält die Fähigkeiten ' der Lautstärkeregelung ' Lautstärkeregelung möglich ' Private Const AUXCAPS_VOLUME = &H1 ' Seperate Links/Rechts Laustärkeregelung möglich ' Private Const AUXCAPS_LRVOLUME = &H2 Private Type AUXCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * 32 wTechnology As Integer dwSupport As Long End Type Public Type VolumeSetting LeftVol As Integer RightVol As Integer End Type Private MMError As Integer ' auxGetNumDevs Liefert die Anzahl der verfügbaren ' Audiogeräte von Null beginnend ' Beispiel: auxGetNumDevs = 7 ' dann sind die Geräte ID's 0-6 Public Function Get_NumDeviceID() As Integer Get_NumDeviceID = auxGetNumDevs - 1 End Function ' auxGetDevCaps Liefert Informationen von einem ' Audiogerät Public Function Get_DeviceName(ByVal DeviceID As Integer) _ As String If DeviceID < 0 Or DeviceID > Get_NumDeviceID Then _ Exit Function Dim AUX As AUXCAPS ' Hier wird AUX mit den Devicedaten gefüllt Call auxGetDevCaps(DeviceID, AUX, Len(AUX)) ' Trennen von vbNullChar-Zeichen und zurückgeben Get_DeviceName = Left$(AUX.szPname, _ InStr(1, AUX.szPname, vbNullChar) - 1) End Function ' Gibt die prozentuale Lautstärke wieder Public Function Get_DeviceVolume(ByVal DeviceID As Long) _ As VolumeSetting If DeviceID < 0 Or DeviceID > Get_NumDeviceID Then _ Exit Function Dim Volume As VolumeSetting, BothVolumes As Long ' BothVolumes Füllen Call auxGetVolume(DeviceID, BothVolumes) ' Rechte und Linke Lautstärke trennen Call CopyMemory(Volume, BothVolumes, Len(Volume)) ' Funktionsaufruf für die Prozentausrechnung With Get_DeviceVolume .LeftVol = Get_PercentVolume(Volume.LeftVol) .RightVol = Get_PercentVolume(Volume.RightVol) End With End Function ' Rechnet aus wieviel Prozent die Laustärke ist Private Function Get_PercentVolume(ByVal Volume As Integer) _ As Long ' Bei der Laustärke ist zu beachten, daß die ' Laustärke in 2 Teilen aufgeteilt ist: ' 0 bis 32767 und -32767 bis -1 ' ' Beispiel: ganz leise = 0 ' etwas lauter = 11000 ' ungefär mittellaut = 32767 ' mehr als mittellaut = - 22000 ' ganz laut = -1 If Volume > 0 Then Get_PercentVolume = 100 / 65535 * Volume Else Get_PercentVolume = (100 / 65535) * (65535 + Volume) End If End Function ' Setzen der prozentualen Laustärke Public Function Set_DeviceVolume(ByVal DeviceID As Long, _ ByVal LeftVolume As Long, ByVal RightVolume As Long) If DeviceID < 0 Or DeviceID > Get_NumDeviceID Then _ Exit Function Dim Volume As VolumeSetting, BothVolumes As Long ' Funktionsaufruf für die Prozentausrechnung Volume.LeftVol = Set_PercentVolume(LeftVolume) Volume.RightVol = Set_PercentVolume(RightVolume) ' Linke und Rechte Lautstärke in BothVolumes vereinen Call CopyMemory(BothVolumes, Volume.LeftVol, Len(Volume)) ' Lautstärke setzen Call auxSetVolume(DeviceID, BothVolumes) End Function ' Rechnet die prozentuale Laustärke aus Private Function Set_PercentVolume(ByVal Volume As Long) _ As Long If Volume <= 50 Then Set_PercentVolume = (65535 / 100) * Volume Else Set_PercentVolume = (65535 / 100) * (65535 + Volume) End If End Function Anwendungsbeispiel: ' Beispiel für die Funktionsaufrufe Sub Main() Dim i As Integer For i = 0 To Get_NumDeviceID Debug.Print "Lautstärke: " & Get_DeviceName(i) + _ " Links: " & Get_DeviceVolume(i).LeftVol + _ " Rechts: " & Get_DeviceVolume(i).RightVol ' Geht natürlich auch bei Set_DeviceVolume ' Set_DeviceVolume i, 50, 50 Next i End Sub Hinweis: Dieser Tipp wurde bereits 36.144 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
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. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |