Controlling Volumes

[bmarzouk]

Any one can tell me how to raise or lower the sound volume from Visual Basic

[Wak]

Public Const HIGHEST_VOLUME_SETTING = 12

'Put these into a module
' device ID for aux device mapper
Public Const AUX_MAPPER = -1&
Public Const MAXPNAMELEN = 32

Type AUXCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
wTechnology As Integer
dwSupport As Long
End Type

' flags for wTechnology field in AUXCAPS structure
Public Const AUXCAPS_CDAUDIO = 1 ' audio from internal CD-ROM drive
Public Const AUXCAPS_AUXIN = 2 ' audio from auxiliary input jacks

' flags for dwSupport field in AUXCAPS structure
Public Const AUXCAPS_VOLUME = &H1 ' supports volume control
Public Const AUXCAPS_LRVOLUME = &H2 ' separate left-right volume control

Declare Function auxGetNumDevs Lib "winmm.dll" () As Long
Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" _
(ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As Long

Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, _
ByVal dwVolume As Long) As Long
Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, _
ByRef lpdwVolume As Long) As Long
Declare Function auxOutMessage Lib "winmm.dll" (ByVal uDeviceID As Long, _
ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

'* Possible Return values from auxGetVolume, auxSetVolume *
Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)

'* Use the CopyMemory function from the Windows API *
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

'* Use this structure to break the Long into two Integers *
Public Type VolumeSetting
LeftVol As Integer
RightVol As Integer
End Type

Sub lCrossFader()
Vol1 = 100 - Slider1.Value ' Left
Vol2 = 100 - Slider5.Value ' Right
E = CrossFader.Value
F = 100 - E
If Check4.Value = 1 Then ' Half Fader Check
LVol = (F * Val(Vol1) / 100) * 2
RVol = (E * Val(Vol2) / 100) * 2
If LVol > (50 * Val(Vol1) / 100) * 2 Then
LVol = (50 * Val(Vol1) / 100) * 2
End If
If RVol > (50 * Val(Vol2) / 100) * 2 Then
RVol = (50 * Val(Vol2) / 100) * 2
End If
Else
LVol = (F * Val(Vol1) / 100)
RVol = (E * Val(Vol2) / 100)
End If
Label1.Caption = "Fader: " + LTrim$(Str$(LVol)) + " x " + LTrim$(Str$(RVol))

End Sub


Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As _
Long, lDeviceID As Long) As Long
Dim bReturnValue As Boolean ' Return Value from Function
Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
' two Integers.

Dim lAPIReturnVal As Long ' Return value from API Call
Dim lBothVolumes As Long ' The API passed value of the Combined Volumes

Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)

lDataLen = Len(Volume)
CopyMemory lBothVolumes, Volume.LeftVol, lDataLen

'* Set the Value to the API *
lAPIReturnVal = auxSetVolume(lDeviceID, lBothVolumes)
lSetVolume = lAPIReturnVal

End Function

Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol _
As Long, lDeviceID As Long) As Long

Dim bReturnValue As Boolean ' Return Value from Function
Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
' two Integers.
Dim lAPIReturnVal As Long ' Return value from API Call
Dim lBothVolumes As Long ' The API Return of the Combined Volumes

'* Get the Value from the API *
lAPIReturnVal = auxGetVolume(lDeviceID, lBothVolumes)

lDataLen = Len(Volume)
CopyMemory Volume.LeftVol, lBothVolumes, lDataLen

lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535

lGetVolume = lAPIReturnVal
End Function

Public 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

Public 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