Beschreibung: Deklaration: Declare Function auxSetVolume Lib "winmm.dll" ( _ ByVal uDeviceID As Long, _ ByVal dwVolume As Long) As Long Parameter:
Rückgabewert: Const MMSYSERRR_NOERROR = 0 ' Kein Fehler Const MMSYSERR_BASE = 0 ' Basis Konstante Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE+ 2) ' Falscher Geräte ID Beispiel: Private Declare Function auxSetVolume Lib "winmm.dll" ( _ ByVal uDeviceID As Long, _ ByVal dwVolume As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Const MMSYSERR_NOERROR = 0 Private Const MMSYSERR_BASE = 0 Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2) Private Sub Command1_Click() Dim Volume(1) As Integer, AuxSetVol As Long Dim Retval As Long, Gerät As Integer Gerät = 0 ' meist Wave ' Stumm schalten MsgBox "Die Lautstärke wird jetzt auf 0% geschaltet", vbInformation, _ "Stumm schalten" Volume(0) = 0 'Linker Kanal = ganz leise Volume(1) = 0 'Rechter Kanal = ganz leise Call CopyMemory(AuxSetVol, Volume(0), Len(Volume(0)) * 2) Retval = auxSetVolume(Gerät, AuxSetVol) If Retval = MMSYSERR_BADDEVICEID Then _ MsgBox "Gerät " & Gerät & " wurde nicht gefunden", _ vbCritical, "Fehler": Exit Sub ' Mittlere Lautstärke MsgBox "Die Lautstärke wird jetzt auf 50% geschaltet", vbInformation, _ "Mittlere Lautstärke" Volume(0) = 32767 'Linker Kanal = ca. 50% Volume(1) = 32767 'Rechter Kanal = ca. 50% Call CopyMemory(AuxSetVol, Volume(0), Len(Volume(0)) * 2) Retval = auxSetVolume(Gerät, AuxSetVol) If Retval = MMSYSERR_BADDEVICEID Then MsgBox "_ Gerät " & Gerät & " wurde nicht gefunden", _ vbCritical, "Fehler": Exit Sub ' Volle Lautstärke MsgBox "Die Lautstärke wird jetzt auf 100% geschaltet", vbInformation, _ "Volle Lautstärke" Volume(0) = -1 'Linker Kanal = 100% Volume(1) = -1 'Rechter Kanal = 100% Call CopyMemory(AuxSetVol, Volume(0), Len(Volume(0)) * 2) Retval = auxSetVolume(Gerät, AuxSetVol) If Retval = MMSYSERR_BADDEVICEID Then _ MsgBox "Gerät " & Gerät & " wurde nicht gefunden", _ vbCritical, "Fehler": Exit Sub ' Geteilte Lautstärke MsgBox "Die Lautstärke wird jetzt auf 100% / 0% geschaltet", vbInformation, _ "Geteilte Lautstärke" Volume(0) = -1 'Linker Kanal = 100% Volume(1) = 0 'Rechter Kanal = 0% Call CopyMemory(AuxSetVol, Volume(0), Len(Volume(0)) * 2) Retval = auxSetVolume(Gerät, AuxSetVol) If Retval = MMSYSERR_BADDEVICEID Then _ MsgBox "Gerät " & Gerät & " wurde nicht gefunden", _ vbCritical, "Fehler": Exit Sub End Sub Diese Seite wurde bereits 17.483 mal aufgerufen. |
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. Buchempfehlung Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. Access-Tools Vol.1 ![]() Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||
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. |