vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Suche Visual-Basic Code
Re: Lautstärke 
Autor: Levis
Datum: 29.07.02 20:54

Ich habe das auch mal in einem meiner Projekte gebraucht. Ist glaub ich sogar aus dem Tricks und Tipps Archiv.

'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


Beispiel:
'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
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Lautstärke95L.B.29.07.02 20:25
Re: Lautstärke86Levis29.07.02 20:54

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel