用mixer API控制系统音量的问题100 求解

[broown]

如题，用该组API来控制系统音量，能获得当前的系统音量信息，能调节系统音量大小，MSDN上介绍了相关步骤，还有示例代码，居然看得出明显的逻辑错误，讶异，由于功力不足，修改后也得不到想要的结果，求哪位仁兄来指导指导啊，贴些代码给看看，相关的就行，多多亦善，麻烦加中文注解。

[薛定谔之死猫]

关注一下先

[qyii]

来懒一懒!

[j_x_y]

建议使用：
waveOutSetVolume
waveOutGetVolume

[broown]

详细点！

[薛定谔之死猫]

帮你up

[broown]

没人再帮帮我啊？

[liuyan4794]

http://vbworld.sxnw.gov.cn/Source/index.asp?kind=api&page=2
中的mixer.zip能够控制系统的音量，但没有获得系统的音量

[fuanwei]

Option Explicit
Private hmem As Long
Const MMSYSERR_NOERROR = 0
Const MAXPNAMELEN = 32
Const MIXER_LONG_NAME_CHARS = 64
Const MIXER_SHORT_NAME_CHARS = 16
Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Const MIXERCONTROL_CONTROLTYPE_FADER = _
(MIXERCONTROL_CT_CLASS_FADER Or _
MIXERCONTROL_CT_UNITS_UNSIGNED)
Const MIXERCONTROL_CONTROLTYPE_VOLUME = _
(MIXERCONTROL_CONTROLTYPE_FADER + 1)
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
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 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)
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 mixerSetControlDetails Lib "winmm.dll" _
(ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
ByVal fdwDetails 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 hmixer As Long
Private volCtrl As MIXERCONTROL ' Waveout volume control.
Private micCtrl As MIXERCONTROL ' Microphone volume control.
Private mvarprMicVolume As Long 'Local copy
Private mvarprMicMaxVolume As Long 'Local copy
Private mvarprMicMinVolume As Long 'Local copy
Private mvarprSpeakerVolume As Long 'Local copy
Private mvarprSpeakerMaxVolume As Long 'Local copy
Private mvarprSpeakerMinVolume As Long 'Local copy
Private mvarprMixerErr As Long 'Local copy
Private Function fGetVolumeControl(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
With mxlc
.cbStruct = Len(mxlc)
.dwLineID = mxl.dwLineID
.dwControl = ctrlType
.cControls = 1
.cbmxctrl = Len(mxc)
End With
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
fGetVolumeControl = True
Call CopyStructFromPtr(mxc, mxlc.pamxctrl, Len(mxc))
Else
fGetVolumeControl = False
End If
Call GlobalFree(hmem)
Exit Function
End If
fGetVolumeControl = False
End Function
Private Function fSetVolumeControl(ByVal hmixer As Long, _
mxc As MIXERCONTROL, ByVal volume As Long) As Boolean
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
hmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
vol.dwValue = volume
Call CopyPtrFromStruct(mxcd.paDetails, vol, Len(vol))
rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
Call GlobalFree(hmem)
If MMSYSERR_NOERROR = rc Then
fSetVolumeControl = True
Else
fSetVolumeControl = False
End If
End Function
Public Function meOpenMixer() As Long
Dim rc As Long
Dim bOK As Boolean
rc = mixerOpen(hmixer, 0, 0, 0, 0)
mvarprMixerErr = rc
If MMSYSERR_NOERROR <> rc Then
MsgBox "Could not open the mixer.", vbCritical, "Volume Control"
Exit Function
End If
bOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
If bOK Then
mvarprSpeakerMaxVolume = volCtrl.lMaximum
mvarprSpeakerMinVolume = volCtrl.lMinimum
End If
bOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)
If bOK Then
mvarprMicMaxVolume = micCtrl.lMaximum
mvarprMicMinVolume = micCtrl.lMinimum
End If
End Function
Public Property Get prMixerErr() As Long
prMixerErr = mvarprMixerErr
End Property
Public Property Get prSpeakerMinVolume() As Long
prSpeakerMinVolume = mvarprSpeakerMinVolume
End Property
Public Property Get prSpeakerMaxVolume() As Long
prSpeakerMaxVolume = mvarprSpeakerMaxVolume
End Property
Public Property Let prSpeakerVolume(ByVal vData As Long)
mvarprSpeakerVolume = vData
Call fSetVolumeControl(hmixer, volCtrl, vData)
End Property
Public Property Get prSpeakerVolume() As Long
prSpeakerVolume = mvarprSpeakerVolume
End Property
Public Property Get prMicMinVolume() As Long
prMicMinVolume = mvarprMicMinVolume
End Property
Public Property Get prMicMaxVolume() As Long
prMicMaxVolume = mvarprMicMaxVolume
End Property
Public Property Let prMicVolume(ByVal vData As Long)
mvarprMicVolume = vData
Call fSetVolumeControl(hmixer, micCtrl, vData)
End Property
Public Property Get prMicVolume() As Long
prMicVolume = mvarprMicVolume
End Property

[fuanwei]

Option Explicit

Const MMSYSERR_NOERROR = 0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_PURGE = &H40
Const SND_FILENAME = &H20000
Dim MyVolume As clsVolume
'
'Play a wave file.
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long

Private Sub Form_Load()

Set MyVolume = New clsVolume

MyVolume.meOpenMixer

If MyVolume.prMixerErr = MMSYSERR_NOERROR Then
With vsVolume
.Max = MyVolume.prSpeakerMinVolume
.Min = MyVolume.prSpeakerMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
End With
With vsMic
.Max = MyVolume.prMicMinVolume
.Min = MyVolume.prMicMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
.Enabled = True
End With
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set MyVolume = Nothing
Set frmVolume = Nothing
End Sub


Private Sub LblQuit_Click()
Unload Me
End Sub

Private Sub lblPlay_Click()
Dim l As Long
Dim lFlags As Long
Dim sSoundName As String
'
'Open a wavefile and initialize the form.
'
On Error GoTo lblPlayError
With CommonDialog1
.FileName = "*.wav"
.DefaultExt = "wav"
.Filter = "Wav (*.wav)"
.FilterIndex = 1
.Flags = cdlOFNPathMustExist Or cdlOFNFileMustExist
.DialogTitle = "Select a Wave File"
.CancelError = True
.ShowOpen
sSoundName = .FileName
End With

lFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound(sSoundName, 0, lFlags)

lblPlayError:
End Sub

Private Sub lblStop_Click()
'dss
'Dim l As Long
'
'l = PlaySound("", 0, SND_PURGE)

Dim l As Long
Dim lFlags As Long

lFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound("", 0, lFlags)
End Sub

Private Sub vsMic_Change()
Dim lVol As Long

lVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsMic_Scroll()
Dim lVol As Long

lVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsVolume_Change()
Dim lVol As Long

lVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub
Private Sub vsVolume_Scroll()
Dim lVol As Long

lVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub

[boyzhang]

up

[broown]

to fuanwei(草原上狂奔的蜗牛):
能不能大概讲讲原理，代码实在有点长，只需要告诉我获得音量相关的API
如：
看了你的代码，好像是要用到wimm.dll这个库
但这个库中我看了有很多函数，也查了msdn,实在是搞不懂，到底控制音量是怎么样的一个过程?

[liuyan4794]

第一步：初始化（mixerGetNumDevs，mixerOpen，mixerGetDevCaps）
第二步： 获取需要控制的设备Id（mixerGetLineInfo，mixerGetLineControls）
第三步：获取该设备的值（mixerGetControlDetails）
设置该设备的值（mixerSetControlDetails）
设备的值变化时，可以用采用获取消息的方法
离开时（mixerClose）