1 Attachment(s)
Gaining control of the Volume
Most of this code was lifted from MSDN so I'm not exactly sure how it functions. Which is the problem. The code does work. It will allow me to set the volume. What it doesn't do is tell me what the current volume is. Anybody want to take a shot at tweaking it so that the Function GetVolume Control will also tell me what the current volume is? Here is the corrected code:
Module1
Code:
Option Explicit
Public Const MMSYSERR_NOERROR = 0
Public Const MAXPNAMELEN = 32
Public Const MIXER_LONG_NAME_CHARS = 64
Public Const MIXER_SHORT_NAME_CHARS = 16
Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Public Const MIXER_CONTROLDETAILSF_VALUE = &H0&
Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Public Const MIXER_COMPONENTTYPE_DST_FIRST = &H0&
Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FISRST+4)
Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Public Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER or MIXERCONTROL_CT_UNITS_UNSIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj as Long, pmxlc as MIXERLINECONTROLS, ByVal fdwControls as Long) as Long
Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj as Long, pmxl as MIXERLINE, ByVal fdwInfo as Long) as Long
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
Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj as Long, pmxcd as MIXERCONTROLDETAILS, ByVal fdwDetails as Long) as Long
Declare Sub CopyStructFrom Ptr Lib "kernel32" Alias "RtlMoveMemory" (struct as Any, ByVal ptr as Long, ByVal cb as Long)
Declare Sub CopyPtrFromStruct Lib "Kernel32" Alias "RtlMoveMemory" (ByVal ptr as Long, struct as Any, ByVal cb as Long)
Declare Function GlabalAlloc Lib "kernel32" (ByVal wFlags as Long, ByVal dwBytes as Long) as Long
Declare Function GlobalLock Lib "kernel32" (ByVal hmem as Long) as Long
Declare Function GlobalFree Lib "kernel32" (ByVal hmem 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_UNSIGNED
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
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 Line
dwlineID as Long
dwControl as Long
cControls as Long
cbmxctrl as Long
pamxctrl as Long
End Type
Function GetVolumeControl (ByVal hmixer as Long, ByVal componentType as Long, ByVal ctrlType as Long, ByRef mxc as MixerControl) as Boolean
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)
If (MMSYSERR_NOERROR = rc) 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)
rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
If(MMSYSERR_NOERROR = rc) then
GetVolumeControl = True
Else
GetVolumeControl = False
End If
GlobalFree (hmem)
Exit Function
End If
GetVolumeControl = False
End Function
Function SetVolumeControl (ByVal hmixer as Long, mxc as MIXERCONTROL, byVal volume as Long) as Boolean
Dim mxcd as MIXERCONTROLDETAILS
Dim Vol as MIXERCONTROLDETAILS_UNSIGNED
Dim rc as Long
Dim hmem as Long
mxcd.itme = 0
mxcd.dwControlID = mxc.dwControlID
mxcd.cbStruct = Len(mxcd)
mxcd.cbDetails = Len(Vol)
hmem = GlobalAlloc(&H40, Len(Vol))
mxcd.paDetails = GlobalLock (hmem)
mxcd.cChannels = 1
Vol.dwValue = volume
CopyPtrFromStruct mxcd.paDetails, Vol, Len(Vol)
rc = mixerSetControlDetails (hmixer, mxcd, MIXER_GETCONTROLDETAILSF_Value)
GlobalFree (hmem)
If ((MMSYSERR_NOERROR = rc) then
SetVolumeControl = True
Else
SetVolumeControl = False
End If
End Function
On form 1 there are two labels, a textbox and a button. When the form loads the volume range is automatically placed into label1. Place a number (within range) in the textbox and press the command button. The volume is adjusted to that number.
What I need is, on the form_Load, the current volume be placed into label2.
Form1
Code:
Option Explicit
Dim hmixer as Long
Dim volCtrl as MIXERCONTROL
Dim rc as Long
Dim ok as Boolean
Private Sub Form Load()
rc = mixerOpen(hmixer, 0, 0, 0, 0)
If (MMSYSERR_NOERROR <> rc) then
MsgBox "Couldn't open the mixer."
Exit Sub
End If
ok = GetVolumeControl (hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
If (ok=True) then
Label1.Caption = volCtrl.lMinimum & " to " & volCtrl.lMaximum
End If
End Sub
Private Sub Command1_Click()
Dim Vol as Long
Vol = CLong(Text1.Text)
SetVolumeControl.hmixer, volCtrl, Vol
End Sub
Attached is a zip containing the code.
