Following will read AND update the mutecontrols.
it will look at both the MasterMute and the WaveMute
DONE!... A bit of work so I'd appreciate some reactions :)
Option Explicit
Private Const MMSYSERR_NOERROR As Long = 0
Private Const MAXPNAMELEN As Long = 32
Private Const MIXER_LONG_NAME_CHARS As Long = 64
Private Const MIXER_SHORT_NAME_CHARS As Long = 16
Private Const MIXER_OBJECTF_HANDLE As Long = &H80000000
Private Const MIXER_OBJECTF_MIXER As Long = &H0&
Private Const MIXER_OBJECTF_HMIXER As Long =
(MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER)
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE As Long = &H3&
Private Const MIXER_GETCONTROLDETAILSF_VALUE As Long = &H0&
Private Const MIXER_SETCONTROLDETAILSF_VALUE As Long = &H0&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE As Long = &H2&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST As Long = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS As Long =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Private Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN As Long =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST As Long = &H1000&
Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT As Long =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)
Private Const MIXERCONTROL_CT_CLASS_SWITCH As Long = &H20000000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN As Long = &H0&
Private Const MIXERCONTROL_CT_UNITS_BOOLEAN As Long = &H10000
Private Const MIXERCONTROL_CONTROLTYPE_BOOLEAN As Long =
(MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or
MIXERCONTROL_CT_UNITS_BOOLEAN)
Private Const MIXERCONTROL_CONTROLTYPE_MUTE As Long =
(MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long)
As Long
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
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias
"mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal
fdwInfo As Long) As Long
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
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal
hmxobj As Long, ByRef pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As
Long) 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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
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
Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type
Type MIXERCONTROLDETAILS_BOOLEAN
dwValue As Long
End Type
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
Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type
Function MuteIT(Optional bChange As Boolean, Optional bState As
Boolean) As Boolean
' This function reads and optionally sets the state
' of the mastermute and wavemute controls
' For disabling mute BOTH mutes will be set to false.
' For enabling mute ONLY the master mute will be set
Dim hMixer As Long ' mixer handle
Dim hMem As Long ' memory handle
Dim rc As Long
Dim iErr As Integer
Dim iDev As Integer
Dim bMuted(1 To 2) As Boolean
' Open the mixer with deviceID 0.
rc = mixerOpen(hMixer, 0, 0, 0, 0)
If ((MMSYSERR_NOERROR < rc)) Then iErr = 1: GoTo theExit
For iDev = 1 To 2
Dim mxc As MIXERCONTROL
Dim mxl As MIXERLINE
Dim mxlc As MIXERLINECONTROLS
Dim mxcd As MIXERCONTROLDETAILS
Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN
mxl.cbStruct = Len(mxl)
Select Case iDev
Case 1: mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
'MasterMute
Case 2: mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT
'WaveMute
End Select
' Obtain a line corresponding to the component type
rc = mixerGetLineInfo(hMixer, mxl, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If (MMSYSERR_NOERROR < rc) Then iErr = 2: GoTo theExit
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_MUTE
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)
' Allocate a buffer for the control
hMem = GlobalAlloc(&H40, 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 iErr = 3: GoTo theExit
'Copy into mxc structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
GlobalFree (hMem): hMem = 0
'Get the controldetails
mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = mxc.dwControlID
mxcd.cChannels = 1
mxcd.item = 0
mxcd.cbDetails = Len(mxcdMute)
' Allocate a buffer for the controldetails
hMem = GlobalAlloc(&H40, Len(mxcdMute))
mxcd.paDetails = GlobalLock(hMem)
'Get the controldetailvalue
rc = mixerGetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE)
If (MMSYSERR_NOERROR < rc) Then iErr = 4: GoTo theExit
' Copy into mxcdMute structure
CopyStructFromPtr mxcdMute, mxcd.paDetails, Len(mxcdMute)
GlobalFree (hMem): hMem = 0
bMuted(iDev) = CBool(mxcdMute.dwValue)
If bChange Then
If bMuted(iDev) < bState Then
mxcdMute.dwValue = IIf(bState And iDev = 1, 1, 0)
CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)
'update the mixercontrol
rc = mixerSetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE)
If (MMSYSERR_NOERROR < rc) Then iErr = 5: GoTo theExit
bMuted(iDev) = CBool(mxcdMute.dwValue)
End If
End If
Next
theExit:
If hMem Then GlobalFree (hMem)
If hMixer Then mixerClose (hMixer)
If iErr < 0 Then
MsgBox "Error in MuteIt" & vbLf & _
"exit code:" & iErr & "Device:" & iDev
Else
MuteIT = (bMuted(1) Or bMuted(2))
End If
End Function
--
keepITcool
|
www.XLsupport.com | keepITcool chello nl | amsterdam
Mike wrote :
Thanks in advance for your help.
Does anyone have some VBA code that will unmute the sound
for the Windows Volume control using Excel?
I read some stuff in Walkenbach's book about displaying
stuff from the Control Panel within Excel using windows
API calls but I didn't see anything about changing the
volume settings. Thanks again.