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