如何用vb控制系统的声音

如何用vb控制系统的声音

Option Explicit

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Const WM_APPCOMMAND As Long = &H319
Private Const APPCOMMAND_VOLUME_UP As Long = 10
Private Const APPCOMMAND_VOLUME_DOWN As Long = 9
Private Const APPCOMMAND_VOLUME_MUTE As Long = 8

Dim MyVolume
Private Sub Form_Load()
Set MyVolume = New clsVolume
MyVolume.meOpenMixer
End Sub

Private Sub Label1_Click()
'音量增加
SendMessage Me.hwnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_UP * &H10000
getVol
End Sub

Private Sub Label2_Click()
'音量减少
SendMessage Me.hwnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_DOWN * &H10000
getVol
End Sub

Private Sub Label3_Click()
'静音
SendMessage Me.hwnd, WM_APPCOMMAND, &H200EB0, APPCOMMAND_VOLUME_MUTE * &H10000
getVol
End Sub

=========================
clsVolume.cls
=========================
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 ' 波形音量
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 Long

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
' 获取Wave音量控制
bOK = fGetVolumeControl(hmixer, _
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
' 如果函数取得对音量的控制
' 那么最大、最小音量则和变量lMaximum、lMinimum相符合
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

有问题请Hi

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Dim vol1
i = waveOutSetVolume(0, -1) '最大音量
i = waveOutSetVolume(0, 1100000000) '音量适中
i = waveOutSetVolume(0, 0) '音量小
i = waveOutSetVolume(0, vol1) '恢复原始音量
k = App.Path + "\*.wav" '播放音乐
L = &H1 Or &H2 '识别标识
i = sndPlaySound(k, L) '播放音乐

API
Public Declare Function waveOutGetVolume Lib "winmm.dll" Alias "waveOutGetVolume" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function waveOutSetVolume Lib "winmm.dll" Alias "waveOutSetVolume" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
以下是MSDN上的
waveOutGetVolume 取得系统声音
The waveOutGetVolume function retrieves the current volume level of the specified waveform-audio output device.
MMRESULT waveOutGetVolume(
HWAVEOUT hwo,
LPDWORD pdwVolume
);
waveOutSetVolume 设置系统声音
The waveOutSetVolume function sets the volume level of the specified waveform-audio output device.
MMRESULT waveOutSetVolume(
HWAVEOUT hwo,
DWORD dwVolume
);

Parameters
hwo
Handle of an open waveform-audio output device. This parameter can also be a device identifier.
dwVolume
New volume setting. The low-order word contains the left-channel volume setting, and the high-order word contains the right-channel setting. A value of 0xFFFF represents full volume, and a value of 0x0000 is silence.
If a device does not support both left and right volume control, the low-order word of dwVolume specifies the volume level, and the high-order word is ignored.
Return Values
Returns MMSYSERR_NOERROR if successful or an error otherwise. Possible error values include the following:
Value Description
MMSYSERR_INVALHANDLE Specified device handle is invalid.
MMSYSERR_NODRIVER No device driver is present.
MMSYSERR_NOMEM Unable to allocate or lock memory.
MMSYSERR_NOTSUPPORTED Function is not supported.