vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Multimedia & Sound · Audio   |   VB-Versionen: VB4, VB5, VB608.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:   LonelySuicide666Bewertung:  Views:  36.148 
www.vbapihelpline.deSystem:  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.
 



Anzeige

Kauftipp Unser Dauerbrenner!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.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


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.