怎样在VB中添加一个按钮控制声音！！

Question

我想在VB中添加一个"音量"的按钮，点击后可以显示系统栏的音量控制。我记得只要添加一句话调用就可以实现，请问一下具体是什么语句
   谢谢！！！

Answer 1

自己控制
模块声明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
'
'Allocates the specified number of bytes from the heap.
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
'
'Locks a global memory object and returns a pointer to the
' first byte of the object's memory block.  The memory block
' associated with a locked object cannot be moved or discarded.
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
'
'Frees the specified global memory object and invalidates its handle.
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)
'
'Opens a specified mixer device and ensures that the device
' will not be removed until the application closes the handle.
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
'
'Sets properties of a single control associated with an audio line.
Private Declare Function mixerSetControlDetails Lib "winmm.dll" _
    (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
    ByVal fdwDetails As Long) As Long
'
'Retrieves information about a specific line of a mixer device.
Private Declare Function mixerGetLineInfo Lib "winmm.dll" _
    Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, _
    pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
'
'Retrieves one or more controls associated with an audio line.
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 ' Waveout volume control.
Private micCtrl As MIXERCONTROL ' Microphone volume control.
'
'Local variable to save properties
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 copyPrivate Function fGetVolumeControl(ByVal hmixer As Long, _
        ByVal componentType As Long, ByVal ctrlType As Long, _
        ByRef mxc As MIXERCONTROL) As Boolean
'
' This function attempts to obtain a mixer control.
'
Dim mxlc As MIXERLINECONTROLS
Dim mxl  As MIXERLINE
Dim hmem As Long
Dim rc   As Longmxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType
'
' Get a line corresponding to the component type.
'
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
    '
    ' 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
        fGetVolumeControl = True
        '
        ' Copy the control into the destination structure.
        '
        Call CopyStructFromPtr(mxc, mxlc.pamxctrl, Len(mxc))
    Else
        fGetVolumeControl = False
    End If
    Call GlobalFree(hmem)
    Exit Function
End If
fGetVolumeControl = False
End Function

Answer 2

Private Function fSetVolumeControl(ByVal hmixer As Long, _
    mxc As MIXERCONTROL, ByVal volume As Long) As Boolean
'
' This function sets the value for a volume control.
'
Dim 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 With
'
' Allocate a buffer for the control value buffer.
'
hmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
vol.dwValue = volume
'
' Copy the data into the control value buffer.
'
Call CopyPtrFromStruct(mxcd.paDetails, vol, Len(vol))
'
' Set the control value.
'
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 Boolean
'
' Open the mixer with deviceID 0.
'
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
'
' Get the waveout volume control.
'
bOK = fGetVolumeControl(hmixer, _
        MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
        MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
'
' If the function successfully gets the volume control,
' the maximum and minimum values are specified by
' lMaximum and lMinimum.
'
If bOK Then
        mvarprSpeakerMaxVolume = volCtrl.lMaximum
        mvarprSpeakerMinVolume = volCtrl.lMinimum
End If
'
' Get the microphone volume control.
'
bOK = 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

Answer 3

窗体：
Option ExplicitConst 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 LongPrivate Sub Form_Load()Set MyVolume = New clsVolumeMyVolume.meOpenMixerIf 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 SubPrivate Sub Form_Unload(Cancel As Integer)
Set MyVolume = Nothing
Set frmVolume = Nothing
End Sub
Private Sub LblQuit_Click()
Unload Me
End SubPrivate 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 WithlFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound(sSoundName, 0, lFlags)lblPlayError:
End SubPrivate Sub lblStop_Click()
'dss
'Dim l As Long
'
'l = PlaySound("", 0, SND_PURGE)Dim l          As Long
Dim lFlags     As LonglFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound("", 0, lFlags)
End SubPrivate Sub vsMic_Change()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsMic_Scroll()
Dim lVol As LonglVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsVolume_Change()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub
Private Sub vsVolume_Scroll()
Dim lVol As LonglVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub