''''
'Class1:
Option ExplicitPrivate hmem As LongConst 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 TypePrivate Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End TypePrivate 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 TypePrivate Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End TypePrivate 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 LongPrivate hmixer As Long
Private volCtrl As MIXERCONTROL ' WAV音量
Private micCtrl As MIXERCONTROL ' 麦克风音量Private mvarprMicVolume As Long
Private mvarprMicMaxVolume As Long
Private mvarprMicMinVolume As Long
Private mvarprSpeakerVolume As Long
Private mvarprSpeakerMaxVolume As Long
Private mvarprSpeakerMinVolume As Long
Private mvarprMixerErr As LongPrivate 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 Longmxl.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 FunctionPrivate Function fSetVolumeControl(ByVal hmixer As Long, _
mxc As MIXERCONTROL, ByVal volume As Long) As BooleanDim rc As Long
Dim mxcd As MIXERCONTROLDETAILS
Dim vol As MIXERCONTROLDETAILS_UNSIGNEDWith mxcd
.item = 0
.dwControlID = mxc.dwControlID
.cbStruct = Len(mxcd)
.cbDetails = Len(vol)
End Withhmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
vol.dwValue = volumeCall 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 FunctionPublic Function meOpenMixer() As Long
Dim rc As Long
Dim bOK As Booleanrc = 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 IfbOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)If bOK Then
mvarprSpeakerMaxVolume = volCtrl.lMaximum
mvarprSpeakerMinVolume = volCtrl.lMinimum
End IfbOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)If bOK Then
mvarprMicMaxVolume = micCtrl.lMaximum
mvarprMicMinVolume = micCtrl.lMinimum
End If
End FunctionPublic Property Get prMixerErr() As Long
prMixerErr = mvarprMixerErr
End PropertyPublic Property Get prSpeakerMinVolume() As Long
prSpeakerMinVolume = mvarprSpeakerMinVolume
End PropertyPublic Property Get prSpeakerMaxVolume() As Long
prSpeakerMaxVolume = mvarprSpeakerMaxVolume
End PropertyPublic Property Let prSpeakerVolume(ByVal vData As Long)
mvarprSpeakerVolume = vData
Call fSetVolumeControl(hmixer, volCtrl, vData)
End PropertyPublic Property Get prSpeakerVolume() As Long
prSpeakerVolume = mvarprSpeakerVolume
End PropertyPublic Property Get prMicMinVolume() As Long
prMicMinVolume = mvarprMicMinVolume
End PropertyPublic Property Get prMicMaxVolume() As Long
prMicMaxVolume = mvarprMicMaxVolume
End PropertyPublic Property Let prMicVolume(ByVal vData As Long)
mvarprMicVolume = vData
Call fSetVolumeControl(hmixer, micCtrl, vData)
End PropertyPublic Property Get prMicVolume() As Long
prMicVolume = mvarprMicVolume
End Property''''''''
'form1:
Option ExplicitConst MMSYSERR_NOERROR = 0
Dim MyVolume As Class1Private Sub Form_Load()Set MyVolume = New Class1MyVolume.meOpenMixerIf MyVolume.prMixerErr = MMSYSERR_NOERROR Then
With vsVolume 'VScroll1
.Max = MyVolume.prSpeakerMinVolume
.Min = MyVolume.prSpeakerMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
End With
With vsMic 'VScroll2
.Max = MyVolume.prMicMinVolume
.Min = MyVolume.prMicMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
.Enabled = True
End With
End If
Private Sub vsMic_Change()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
End Sub
Private Sub vsMic_Scroll()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
End Sub
Private Sub vsVolume_Change()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
End Sub
Private Sub vsVolume_Scroll()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
End Sub
'Class1:
Option ExplicitPrivate hmem As LongConst 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 TypePrivate Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End TypePrivate 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 TypePrivate Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End TypePrivate 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 LongPrivate hmixer As Long
Private volCtrl As MIXERCONTROL ' WAV音量
Private micCtrl As MIXERCONTROL ' 麦克风音量Private mvarprMicVolume As Long
Private mvarprMicMaxVolume As Long
Private mvarprMicMinVolume As Long
Private mvarprSpeakerVolume As Long
Private mvarprSpeakerMaxVolume As Long
Private mvarprSpeakerMinVolume As Long
Private mvarprMixerErr As LongPrivate 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 Longmxl.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 FunctionPrivate Function fSetVolumeControl(ByVal hmixer As Long, _
mxc As MIXERCONTROL, ByVal volume As Long) As BooleanDim rc As Long
Dim mxcd As MIXERCONTROLDETAILS
Dim vol As MIXERCONTROLDETAILS_UNSIGNEDWith mxcd
.item = 0
.dwControlID = mxc.dwControlID
.cbStruct = Len(mxcd)
.cbDetails = Len(vol)
End Withhmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
vol.dwValue = volumeCall 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 FunctionPublic Function meOpenMixer() As Long
Dim rc As Long
Dim bOK As Booleanrc = 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 IfbOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)If bOK Then
mvarprSpeakerMaxVolume = volCtrl.lMaximum
mvarprSpeakerMinVolume = volCtrl.lMinimum
End IfbOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)If bOK Then
mvarprMicMaxVolume = micCtrl.lMaximum
mvarprMicMinVolume = micCtrl.lMinimum
End If
End FunctionPublic Property Get prMixerErr() As Long
prMixerErr = mvarprMixerErr
End PropertyPublic Property Get prSpeakerMinVolume() As Long
prSpeakerMinVolume = mvarprSpeakerMinVolume
End PropertyPublic Property Get prSpeakerMaxVolume() As Long
prSpeakerMaxVolume = mvarprSpeakerMaxVolume
End PropertyPublic Property Let prSpeakerVolume(ByVal vData As Long)
mvarprSpeakerVolume = vData
Call fSetVolumeControl(hmixer, volCtrl, vData)
End PropertyPublic Property Get prSpeakerVolume() As Long
prSpeakerVolume = mvarprSpeakerVolume
End PropertyPublic Property Get prMicMinVolume() As Long
prMicMinVolume = mvarprMicMinVolume
End PropertyPublic Property Get prMicMaxVolume() As Long
prMicMaxVolume = mvarprMicMaxVolume
End PropertyPublic Property Let prMicVolume(ByVal vData As Long)
mvarprMicVolume = vData
Call fSetVolumeControl(hmixer, micCtrl, vData)
End PropertyPublic Property Get prMicVolume() As Long
prMicVolume = mvarprMicVolume
End Property''''''''
'form1:
Option ExplicitConst MMSYSERR_NOERROR = 0
Dim MyVolume As Class1Private Sub Form_Load()Set MyVolume = New Class1MyVolume.meOpenMixerIf MyVolume.prMixerErr = MMSYSERR_NOERROR Then
With vsVolume 'VScroll1
.Max = MyVolume.prSpeakerMinVolume
.Min = MyVolume.prSpeakerMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
End With
With vsMic 'VScroll2
.Max = MyVolume.prMicMinVolume
.Min = MyVolume.prMicMaxVolume \ 2
.SmallChange = 1000
.LargeChange = 1000
.Enabled = True
End With
End If
Private Sub vsMic_Change()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
End Sub
Private Sub vsMic_Scroll()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
End Sub
Private Sub vsVolume_Change()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
End Sub
Private Sub vsVolume_Scroll()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货