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:     [ Jetzt bewerten ]	Views:  36.541
www.vbapihelpline.de	System:  Win9x, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 32 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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.