Rubrik: Multimedia & Sound · Audio | VB-Versionen: VB4, VB5, VB6 | 08.02.01 |
Lautstärke-Regelung der installierten Audiogeräte Dieser Tipp zeigt, wie man die Namen aller installierten Audiogeräte auslesen und die Lautstärke ermitteln und ändern kann. | ||
Autor: LonelySuicide666 | Bewertung: | Views: 36.151 |
www.vbapihelpline.de | System: Win9x, Win8, Win10, Win11 | Beispielprojekt auf CD |
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:
Auf unseren Testgeräten funktionierte der Tipp leider nicht unter Windows 2000. Auf einem Win95/98-Rechner funktioniert der Tipp einwandfrei.