-
with this code, the slider bar is set to 63 max, and you can control the volume of the WAVE thing be movin the slide bar. What i'm trying to do is to get it to load what volume the system has (because the slider bar always starts at 0). So why doesn't this work:
Code:
Dim q As String, ahgt, ghtr As String
Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
Private Declare Function auxGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function mciGetDeviceID Lib "WINMM.DLL" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Private Declare Function waveOutGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Type lVolType
v As Long
End Type
Private Type VolType
lv As Integer
rv As Integer
End Type
Private Sub Form_Load()
Dim OldVol As Long
Call waveOutGetVolume(deviceID, OldVol)
Slider1.Value = OldVol / 1000
End Sub
Private Sub Slider1_change()
Dim NewVol As Long
NewVol = Slider1.Value * 1000
Call waveOutSetVolume(deviceID, NewVol)
End Sub
-
This is the code i use for Volume:
Code:
'* This constant holds the value of the Highest Custom volume setting. The '*
'* lowest value will always be zero. *
Public Const HIGHEST_VOLUME_SETTING = 63
'Put these into a module
' device ID for aux device mapper
Public Const MAXPNAMELEN = 32
Public Type WAVEOUTCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
dwFormats As Long
wChannels As Integer
dwSupport As Long
End Type
'* Possible Return values from auxGetVolume, auxSetVolume *
Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)
Public Const DEVICE = 0
'* 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
Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
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 = waveOutSetVolume(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 = waveOutGetVolume(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
And to use it:
Code:
Private Function GetVolume()
Dim LeftVol As Long, RightVol As Long, retval As Long
retval = lGetVolume(LeftVol, RightVol, DEVICE)
GetVolume = CInt((LeftVol + RightVol) / 2)
End Function
Usage:
Code:
MySlider.Value = GetVolume()
-
can i use:
Code:
setVolume() = myslider.value
-
Here, this is my slider code. Put this in a form
Code:
Private Scrolling As Boolean
Private Sub MyLeft_Change()
Dim retval As Long
retval = lSetVolume(CLng(MyLeft.Value), CLng(MyLeft.Value), DEVICE)
End Sub
Private Sub MyLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Scrolling = True
End Sub
Private Sub MyLeft_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Scrolling = False
End Sub
Private Sub Timer1_Timer()
If Not Scrolling Then
Dim LeftVol As Long, RightVol As Long, retval As Long
retval = lGetVolume(LeftVol, RightVol, DEVICE)
MyLeft.Value = CInt((LeftVol + RightVol) / 2)
End If
End Sub
and then this in a module:
Code:
'* This constant holds the value of the Highest Custom volume setting. The '*
'* lowest value will always be zero. *
Public Const HIGHEST_VOLUME_SETTING = 63
'Put these into a module
' device ID for aux device mapper
Public Const MAXPNAMELEN = 32
Public Type WAVEOUTCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
dwFormats As Long
wChannels As Integer
dwSupport As Long
End Type
'* Possible Return values from auxGetVolume, auxSetVolume *
Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)
Public Const DEVICE = 0
'* 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
Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
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 = waveOutSetVolume(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 = waveOutGetVolume(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
