Simple Mixer Control - Visual Basic 6
http://thenxtstep.blogspot.com/
A very simple mixer control
'Begin Code Block
'All code provided as is, by Red-Leif International.
'There is NO GUARANTEE that this code works. If you find that
'this code does not work, but you fix it so it now works, please
'email me the new code, and I will place it on my website.
'Eric :)
'Red-Leif International - http://www.redleif.com/vb
'vbtips@redleif.com''Download the source: ex_mixer.zip
'Special thanks to Brian Morrison for submitting this one...
Option Explicit
Private hmem As Long
Private hmixer As Long
Private volCtrl As MIXERCONTROL
Private Const MMSYSERR_NOERROR = 0
Private Const MAXPNAMELEN = 32
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Private Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)
Private Const MIXERCONTROL_CT_CLASS_METER = &H10000000
Private Const MIXERCONTROL_CT_SC_METER_POLLED = &H0&
Private Const MIXERCONTROL_CT_UNITS_SIGNED = &H20000
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERCONTROL_CONTROLTYPE_SIGNEDMETER = (MIXERCONTROL_CT_CLASS_METER Or MIXERCONTROL_CT_SC_METER_POLLED Or MIXERCONTROL_CT_UNITS_SIGNED)
Private Const MIXERCONTROL_CONTROLTYPE_PEAKMETER = (MIXERCONTROL_CONTROLTYPE_SIGNEDMETER + 1)
Private Const GMEM_FIXED = &H0
Private Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type
Private Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End Type
Private Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
reserved(10) As Long
End Type
Private Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type
Private Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type
'Allocates the specified number of bytes from the heap.
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Locks a global memory object and returns a pointer to the
' first byte of the object's memory block. The memory block
' associated with a locked object cannot be moved or discarded.
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
'Frees the specified global memory object and invalidates its handle.
Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
'Opens a specified mixer device and ensures that the device
' will not be removed until the application closes the handle.
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
'Sets properties of a single control associated with an audio line.
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
'Retrieves information about a specific line of a mixer device.
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
'Retrieves one or more controls associated with an audio line.
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Public Function fGetVolumeControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
' This function attempts to obtain a mixer control.
Dim mxlc As MIXERLINECONTROLS
Dim mxl As MIXERLINE
Dim hmem As Long
Dim rc As Long
mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType
rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) ' Get a line corresponding to the component type.
If MMSYSERR_NOERROR = rc Then
With mxlc
.cbStruct = Len(mxlc)
.dwLineID = mxl.dwLineID
.dwControl = ctrlType
.cControls = 1
.cbmxctrl = Len(mxc)
End With
' Allocate a buffer for the control.
hmem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hmem)
mxc.cbStruct = Len(mxc)
rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) ' Get the control.
If MMSYSERR_NOERROR = rc Then
fGetVolumeControl = True
Call CopyStructFromPtr(mxc, mxlc.pamxctrl, Len(mxc)) ' Copy the control into the destination structure.
Else
fGetVolumeControl = False
End If
Call GlobalFree(hmem)
Exit Function
End If
fGetVolumeControl = False
End Function
Public Sub main()
Dim lRC As Long
Dim bOK As Boolean
Dim lVolume As Long
Dim sTemp() As String
Dim sOperation As String
Dim uOutputVolCtrl As MIXERCONTROL
Dim uMXCD As MIXERCONTROLDETAILS
Dim lVolHmem As Long
lRC = mixerOpen(hmixer, 0, 0, 0, 0)
If MMSYSERR_NOERROR <> lRC Then
MsgBox "Could not open the mixer.", vbCritical, "Volume Control"
Exit Sub
End If
bOK = fGetVolumeControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl) ' Get the waveout volume control.
If bOK Then
bOK = GetControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, MIXERCONTROL_CONTROLTYPE_PEAKMETER, uOutputVolCtrl)
If bOK Then
uMXCD.cbStruct = Len(uMXCD)
lVolHmem = GlobalAlloc(&H0, Len(lVolume))
uMXCD.paDetails = GlobalLock(lVolHmem)
uMXCD.cbDetails = Len(lVolume)
uMXCD.cChannels = 1
uMXCD.dwControlID = uOutputVolCtrl.dwControlID
uMXCD.item = uOutputVolCtrl.cMultipleItems
lRC = mixerGetControlDetails(hmixer, uMXCD, MIXER_GETCONTROLDETAILSF_VALUE)
CopyStructFromPtr lVolume, uMXCD.paDetails, Len(lVolume)
sOperation = GetSetting("SoundMute", "Volume", "Main", "Restore")
If sOperation = "Restore" Then
If InStr(1, Command$, "/v:") > 0 Then
sTemp = Split(Command$, "/")
lVolume = Mid$(sTemp(1), 3)
Else
lVolume = 6000
End If
SaveSetting "SoundMute", "Volume", "Main", "Mute"
Else
lVolume = 0
SaveSetting "SoundMute", "Volume", "Main", "Restore"
End If
Else
MsgBox "Could not open the mixer", vbCritical, "Volume Control"
Exit Sub
End If
fSetVolumeControl hmixer, volCtrl, lVolume
End If
End Sub
Function GetControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
' This function attempts to obtain a mixer control. Returns True if successful.
Dim mxlc As MIXERLINECONTROLS
Dim mxl As MIXERLINE
Dim hmem As Long
Dim rc As Long
mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType
' Obtain a line corresponding to the component type
rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
If (MMSYSERR_NOERROR = rc) Then
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = ctrlType
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)
' Allocate a buffer for the control
'hmem = GlobalAlloc(&H40, Len(mxc))
hmem = GlobalAlloc(GMEM_FIXED, Len(mxc))
mxlc.pamxctrl = GlobalLock(hmem)
mxc.cbStruct = Len(mxc)
' Get the control
rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
If (MMSYSERR_NOERROR = rc) Then
GetControl = True
' Copy the control into the destination structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
Else
GetControl = False
End If
GlobalFree (hmem)
Exit Function
End If
End Function
Private Function fSetVolumeControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal volume As Long) As Boolean
' This function sets the value for a volume control.
Dim rc As Long
Dim mxcd As MIXERCONTROLDETAILS
Dim vol As MIXERCONTROLDETAILS_UNSIGNED
With mxcd
.item = 0
.dwControlID = mxc.dwControlID
.cbStruct = Len(mxcd)
.cbDetails = Len(vol)
End With
' Allocate a buffer for the control value buffer.
hmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
vol.dwValue = volume
' Copy the data into the control value buffer.
Call CopyPtrFromStruct(mxcd.paDetails, vol, Len(vol))
' Set the control value.
rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
Call GlobalFree(hmem)
If MMSYSERR_NOERROR = rc Then
fSetVolumeControl = True
Else
fSetVolumeControl = False
End If
End Function
'End Code Block