VB设置左右声道音量

'
'说明：
'uDeviceID的意义如下：
'0 WAV设备(Wav)
'1 Midi设备
'2 CDAudio设备
'3 线路输入设备 (Aux)
'4 麦克风设备 (Mic)
'5 扬声器 (Speaker)
'6 PC扬声器(PC Speaker)

'lpdwVolume的意义
'lpdwVolume包含了左右声道的音量值，需要采用一定的方法来推算出左右声道的声音：

Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Private Function nSigned(ByVal lUnsignedInt As Long) As Integer
    Dim nReturnVal As Integer                          ' Return value from Function
    If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
        MsgBox "Error in conversion from Unsigned to nSigned Integer"
        nSignedInt = 0
        Exit Function
    End If
    If lUnsignedInt > 32767 Then
        nReturnVal = lUnsignedInt - 65536
    Else
        nReturnVal = lUnsignedInt
    End If
    nSigned = nReturnVal
End Function

Private Function lUnsigned(ByVal nSignedInt As Integer) As Long
    Dim lReturnVal As Long                          ' Return value from Function
    If nSignedInt < 0 Then
        lReturnVal = nSignedInt + 65536
    Else
        lReturnVal = nSignedInt
    End If
    If lReturnVal > 65535 Or lReturnVal < 0 Then
        MsgBox "Error in conversion from nSigned to Unsigned Integer"
        lReturnVal = 0
    End If
    lUnsigned = lReturnVal
End Function

Private Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
   
    Dim Volume As VolumeSetting, lBothVolumes As Long
    Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
    Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
    'copy our Volume-variable to a long
    CopyMemory lBothVolumes, Volume.LeftVol, Len(Volume)
    'call the SetVolume-function
    lSetVolume = auxSetVolume(lDeviceID, lBothVolumes)
   
End Function

Private Sub Form_Load()
    Dim Vol As Long, lVol As Long, rVol As Long
    Call auxGetVolume(1, Vol)
    lVol = Vol Mod CLng(65536)
    'Fix函数，返回参数的整数部分，其类型和参数相同。
    rVol = Fix((Vol - (Vol Mod 65536)) / 65535)
    Text1.Text = convert(lVol)
    Text2.Text = convert(rVol)
    HSL.Value = convert(lVol)
    HSR.Value = convert(rVol)
End Sub

Private Function convert(ByVal Vol As Long) As Integer
    Dim ReturnVal As Long                          ' Return value from Function
    If Vol < 0 Then
        ReturnVal = Vol + 65536
    Else
        ReturnVal = Vol
    End If
    If ReturnVal > 65535 Or lReturnVal < 0 Then
        MsgBox "Error in conversion from nSigned to Unsigned Integer"
        ReturnVal = 0
    End If
    convert = ReturnVal / 65536 * 100
End Function

Private Function deconvert(ByVal lVol As Long, ByVal rVol As Long) As Integer
    Dim ReturnVal As Long
    If lVol = 0 Then ReturnVal = Val("&H" & "0000" & Hex(rVol * 65536 * 65536 / 100))
    If rVol = 0 Then ReturnVal = Val("&H" & Hex(lVol / 100) & "0000")
    ReturnVal = Val("&H" & Hex(lVol * 65536 / 100) & Hex(rVol * 65536 * 65536 / 100))
    deconvert = ReturnVal
End Function

Private Sub HSL_Change()
    Dim Vol As Long
    Text1.Text = HSL.Value
    'Vol = deconvert(HSL.Value, HSR.Value)
    Call auxSetVolume(1, HSL.Value / 100 * 65536)
End Sub

Private Sub HSR_Change()
    Text2.Text = HSR.Value
End Sub