Option Explicit
' API-Funktionen:
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" ( _
ByVal lpstrCommand As String, _
ByVal lpstrRet As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" ( _
ByVal uDeviceID As Long, _
ByVal dwVolume As Long) As Long
Private Type intVolumeType
Left As Integer
Right As Integer
End Type
Private Type lngVolumeType
Value As Long
End Type
Function SignedInteger(ByVal UnsignedInteger As Long) As Integer
' Zur Sicherheit werden nur die niederwertigen 2 Byte
' berücksichtigt.
UnsignedInteger = UnsignedInteger And 65535
If (UnsignedInteger And 32768) Then
' Wenn das MSB gesetzt ist, subtrahieren wir 65536.
SignedInteger = UnsignedInteger - 65536
Else
' Ansonsten können wir den Wert unverändert übernehmen.
SignedInteger = UnsignedInteger
End If
End Function
Sub SetVolume()
Dim intVol As intVolumeType
Dim lngVol As lngVolumeType
intVol.Left = SignedInteger(VScroll1.Value * 6.5535)
intVol.Right = SignedInteger(VScroll1.Value * 6.5535)
LSet lngVol = intVol
Call waveOutSetVolume(0, lngVol.Value)
End Sub
Private Sub Form_Load()
VScroll1.LargeChange = 1000
VScroll1.Min = 10000
VScroll1.Max = 0
VScroll1.Value = 5000
VScroll1.LargeChange = 1000
VScroll1.Min = 10000
VScroll1.Max = 0
VScroll1.Value = 5000
Call SetVolume
End Sub
Private Sub VScroll1_Scroll()
Call SetVolume
End Sub