Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing VolumeMod.bas (10.25 KB)
Attribute VB_Name = "VolumeMod"
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const SETVOLMIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const SETVOLMMYSERR_NOERROR = 0
Private Const SETVOLMAXPNAMELEN = 32
Private Const SETVOLMIXER_LONG_NAME_CHARS = 64
Private Const SETVOLMIXER_SHORT_NAME_CHARS = 16
Private Const SETVOLMIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
'Private Const SETVOLMIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const SETVOLMIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const SETVOLSETVOLMIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const SETVOLSETVOLMIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Private Const SETVOLSETVOLMIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (SETVOLSETVOLMIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Private Const SETVOLSETVOLMIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = (SETVOLSETVOLMIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Private Const SETVOLSETVOLMIXERLINE_COMPONENTTYPE_SRC_LINE = (SETVOLSETVOLMIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
Private Const SETVOLMIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const SETVOLMIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Private Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN = &H0&
Private Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Private Const MIXERCONTROL_CONTROLTYPE_BOOLEAN = (MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or MIXERCONTROL_CT_UNITS_BOOLEAN)
Private Const MIXERCONTROL_CONTROLTYPE_MUTE = (MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)
Private Const SETVOLMIXERCONTROL_CONTROLTYPE_FADER = (SETVOLMIXERCONTROL_CT_CLASS_FADER Or SETVOLMIXERCONTROL_CT_UNITS_UNSIGNED)
Private Const SETVOLMIXERCONTROL_CONTROLTYPE_VOLUME = (SETVOLMIXERCONTROL_CONTROLTYPE_FADER + 1)
'Private Declare Function SETVOLMIXERClose Lib "winmm" (ByVal hmx As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, psetvolmxcd As SETVOLMIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
'Private Declare Function mixerGetDevCaps Lib "winmm" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, ByVal pmxcaps As SETVOLMIXERCAPS, ByVal cbmxcaps As Long) As Long
'Private Declare Function mixerGetID Lib "winmm" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As SETVOLMIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As SETVOLMIXERLINE, ByVal fdwInfo As Long) As Long
'Private Declare Function mixerGetNumDevs Lib "winmm" () As Long
'Private Declare Function mixerMessage Lib "winmm" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Private Declare Function mixerOpen Lib "winmm" (phmx As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm" (ByVal hmxobj As Long, psetvolmxcd As SETVOLMIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Private Type SETVOLMIXERCAPS
wMid As Integer ' manufacturer id
wPid As Integer ' product id
vDriverVersion As Long ' version of the driver
szPname As String * SETVOLMAXPNAMELEN ' product name
fdwSupport As Long ' misc. support bits
cDestinations As Long ' count of destinations
End Type
Private Type SETVOLMIXERCONTROL
cbStruct As Long ' size in Byte of SETVOLMIXERCONTROL
dwControlID As Long ' unique control id for mixer device
dwControlType As Long ' SETVOLMIXERCONTROL_CONTROLTYPE_xxx
fdwControl As Long ' SETVOLMIXERCONTROL_CONTROLF_xxx
cMultipleItems As Long ' if SETVOLMIXERCONTROL_CONTROLF_MULTIPLE set
szShortName As String * SETVOLMIXER_SHORT_NAME_CHARS ' short name of control
szName As String * SETVOLMIXER_LONG_NAME_CHARS ' long name of control
lMinimum As Long ' Minimum value
lMaximum As Long ' Maximum value
reserved(10) As Long ' reserved structure space
End Type
Private Type SETVOLMIXERCONTROLDETAILS
cbStruct As Long ' size in Byte of SETVOLMIXERCONTROLDETAILS
dwControlID As Long ' control id to get/set details on
cChannels As Long ' number of channels in paDetails array
item As Long ' hwndOwner or cMultipleItems
cbDetails As Long ' size of _one_ details_XX struct
paDetails As Long ' pointer to array of details_XX structs
End Type
Private Type SETVOLMIXERCONTROLDETAILS_UNSIGNED
dwValue As Long ' value of the control
End Type
Private Type SETVOLMIXERLINE
cbStruct As Long ' size of SETVOLMIXERLINE structure
dwDestination As Long ' zero based destination index
dwSource As Long ' zero based source index (if source)
dwLineID As Long ' unique line id for mixer device
fdwLine As Long ' state/information about line
dwUser As Long ' driver specific information
dwComponentType As Long ' component type line connects to
cChannels As Long ' number of channels line supports
cConnections As Long ' number of connections (possible)
cControls As Long ' number of controls at this line
szShortName As String * SETVOLMIXER_SHORT_NAME_CHARS
szName As String * SETVOLMIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * SETVOLMAXPNAMELEN
End Type
Private Type SETVOLMIXERLINECONTROLS
cbStruct As Long ' size in Byte of SETVOLMIXERLINECONTROLS
dwLineID As Long ' line id (from SETVOLMIXERLINE.dwLineID)
' SETVOLMIXER_GETLINECONTROLSF_ONEBYID or
dwControl As Long ' SETVOLMIXER_GETLINECONTROLSF_ONEBYTYPE
cControls As Long ' count of controls pmxctrl points to
cbmxctrl As Long ' size in Byte of _one_ SETVOLMIXERCONTROL
pamxctrl As Long ' pointer to first SETVOLMIXERCONTROL array
End Type
'Private Const SETVOLMMYSERR_BASE = 0
'Private Const SETVOLMMYSERR_BADDEVICEID = (SETVOLMMYSERR_BASE + 2)
Public SetVolHmixer As Long ' mixer handle
Public SetVolCtrl As SETVOLMIXERCONTROL ' waveout volume control
Public SetMuteCtrl As SETVOLMIXERCONTROL ' waveout mute control
Public Function GetVolumeValue(ByVal SetVolHmixer As Long, mxc As SETVOLMIXERCONTROL) As Long
Dim setvolmxcd As SETVOLMIXERCONTROLDETAILS
Dim Vol As SETVOLMIXERCONTROLDETAILS_UNSIGNED
Dim hmem As Long
setvolmxcd.item = 0
setvolmxcd.dwControlID = mxc.dwControlID
setvolmxcd.cbStruct = Len(setvolmxcd)
setvolmxcd.cbDetails = Len(Vol)
hmem = GlobalAlloc(&H40, Len(Vol))
setvolmxcd.paDetails = GlobalLock(hmem)
setvolmxcd.cChannels = 1
If mixerGetControlDetails(SetVolHmixer, setvolmxcd, MIXER_GETCONTROLDETAILSF_VALUE) = SETVOLMMYSERR_NOERROR Then
CopyStructFromPtr Vol, setvolmxcd.paDetails, Len(setvolmxcd.paDetails)
GetVolumeValue = Vol.dwValue
End If
GlobalFree hmem
End Function
Public Function InitGetVolume() As Boolean
If SETVOLMMYSERR_NOERROR <> mixerOpen(SetVolHmixer, 0, 0, 0, 0) Then
InitGetVolume = False
Exit Function
End If
GetVolumeControl SetVolHmixer, SETVOLSETVOLMIXERLINE_COMPONENTTYPE_DST_SPEAKERS, SETVOLMIXERCONTROL_CONTROLTYPE_VOLUME, SetVolCtrl
GetVolumeControl SetVolHmixer, SETVOLSETVOLMIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_MUTE, SetMuteCtrl
InitGetVolume = True
End Function
Public Function GetVolumeControl(ByVal SetVolHmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As SETVOLMIXERCONTROL) As Boolean
Dim mxlc As SETVOLMIXERLINECONTROLS
Dim mxl As SETVOLMIXERLINE
Dim hmem As Long
mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType
If SETVOLMMYSERR_NOERROR = mixerGetLineInfo(SetVolHmixer, mxl, SETVOLMIXER_GETLINEINFOF_COMPONENTTYPE) Then
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = ctrlType
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)
hmem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hmem)
mxc.cbStruct = Len(mxc)
If SETVOLMMYSERR_NOERROR = mixerGetLineControls(SetVolHmixer, mxlc, SETVOLMIXER_GETLINECONTROLSF_ONEBYTYPE) Then
GetVolumeControl = True
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
Else
GetVolumeControl = False
End If
GlobalFree hmem
Else
GetVolumeControl = False
End If
End Function
Public Function SetVolumeControl(ByVal SetVolHmixer As Long, mxc As SETVOLMIXERCONTROL, ByVal Volume As Long) As Boolean
Dim setvolmxcd As SETVOLMIXERCONTROLDETAILS
Dim Vol As SETVOLMIXERCONTROLDETAILS_UNSIGNED
Dim hmem As Long
Dim RetVal As Long
setvolmxcd.item = 0
setvolmxcd.dwControlID = mxc.dwControlID
setvolmxcd.cbStruct = Len(setvolmxcd)
setvolmxcd.cbDetails = Len(Vol)
hmem = GlobalAlloc(&H40, Len(Vol))
setvolmxcd.paDetails = GlobalLock(hmem)
setvolmxcd.cChannels = 1
Vol.dwValue = Volume
CopyPtrFromStruct setvolmxcd.paDetails, Vol, Len(Vol)
RetVal = mixerSetControlDetails(SetVolHmixer, setvolmxcd, SETVOLMIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree hmem
If SETVOLMMYSERR_NOERROR = RetVal Then
SetVolumeControl = True
Else
SetVolumeControl = False
End If
End Function