调节系统音量的类(VB原创)

'转载请保留作者版权信息,谢谢.

'set volume & set mute or not mute
'author:海龙
'mail:[e-mail]
'qq:281131020
'msn:[e-mail]
'website:http://xsoft.bokee.com
'date:2006-03-28
Option Explicit

Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes 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 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 mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) 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 mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Private Const MAXPNAMElen = 32  '  max product name length (including NULL)
Private Const MMSYSERR_NOERROR = 0                  '  no error
Private Const GMEM_ZEROINIT = &H40
Private Const CALLBACK_WINDOW = &H10000             '  dwCallback is a HWND
Private Const MIXER_OBJECTF_MIXER = &H0&
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_SOURCE = &H1&
Private Const MIXER_OBJECTF_HANDLE = &H80000000
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Private Const MIXER_OBJECTF_HMIXER = (MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER)
Private Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Private Const MIXERCONTROL_CONTROLTYPE_BOOLEAN = (MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or MIXERCONTROL_CT_UNITS_BOOLEAN)
Private Const MIXERCONTROL_CONTROLTYPE_MUTE = (MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)

Private Type MIXERCONTROLDETAILS_SIGNED
        lValue As Long
End Type
Private Type MIXERCONTROLDETAILS_BOOLEAN
        fValue As Long
End Type
'''''''''''''''''''''''''''''''''''''''''''''''
'自己定义的类型
Private Type MIXERCONTROLDETAILS_SIGNED_ARRAY_2
        v1 As MIXERCONTROLDETAILS_SIGNED
        v2 As MIXERCONTROLDETAILS_SIGNED
End Type
'''''''''''''''''''''''''''''''''''''''''''''''
Private Type MIXERCONTROLDETAILS
        cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS
        dwControlID As Long    '  control id to get/set details on
        cChannels As Long      '  number of channels in paDetails array
        item As Long           ' hwndOwner or cMultipleItems
        cbDetails As Long      '  size of _one_ details_XX struct
        paDetails As Long      '  pointer to array of details_XX structs
End Type
Private Type MIXERCAPS
        wMid As Integer                   '  manufacturer id
        wPid As Integer                   '  product id
        vDriverVersion As Long            '  version of the driver
        szPname As String * MAXPNAMElen   '  product name
        fdwSupport As Long             '  misc. support bits
        cDestinations As Long          '  count of destinations
End Type
Private Type Target    ' for use in MIXERLINE and others (embedded structure)
       
        dwType As Long                 '  MIXERLINE_TARGETTYPE_xxxx
        dwDeviceID As Long             '  target device ID of device type
        wMid As Integer                   '  of target device
        wPid As Integer                   '       "
        vDriverVersion As Long            '       "
        szPname As String * MAXPNAMElen
End Type
Private Type MIXERCONTROL
        cbStruct As Long           '  size in Byte of MIXERCONTROL
        dwControlID As Long        '  unique control id for mixer device
        dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx
        fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx
        cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE set
        szShortName As String * MIXER_SHORT_NAME_CHARS
        szName As String * MIXER_LONG_NAME_CHARS
        Bounds(1 To 6) As Long     '  Longest member of the Bounds union
        Metrics(1 To 6) As Long    '  Longest member of the Metrics union
End Type
Private Type MIXERLINECONTROLS
        cbStruct As Long       '  size in Byte of MIXERLINECONTROLS
        dwLineID As Long       '  line id (from MIXERLINE.dwLineID)
                                             '  MIXER_GETLINECONTROLSF_ONEBYID or
        dwControl As Long  '  MIXER_GETLINECONTROLSF_ONEBYTYPE
        cControls As Long      '  count of controls pmxctrl points to
        cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL
        pamxctrl As Long       '  pointer to first MIXERCONTROL array
End Type
Private Type MIXERLINE
        cbStruct As Long               '  size of MIXERLINE structure
        dwDestination As Long          '  zero based destination index
        dwSource As Long               '  zero based source index (if source)
        dwLineID As Long               '  unique line id for mixer device
        fdwLine As Long                '  state/information about line
        dwUser As Long                 '  driver specific information
        dwComponentType As Long        '  component type line connects to
        cChannels As Long              '  number of channels line supports
        cConnections As Long           '  number of connections (possible)
        cControls As Long              '  number of controls at this line
        szShortName As String * MIXER_SHORT_NAME_CHARS
        szName As String * MIXER_LONG_NAME_CHARS
        tTarget As Target
End Type

'最大最小音量
Private m_lMax As Long, m_lMin As Long
'打开的设备句柄
Private m_hMixer As Long
'设备数GetDevNum
Private m_lDeviceNum As Long
'设备ID
Private m_lDeviceID As Long
'设备功能GetDevCaps
Private m_Caps As MIXERCAPS

'打开设备以调节音量
Public Function OpenDeviceForVolume() As Boolean
   
    OpenDeviceForVolume = False
   
     '系统中混频器的总数量
    If (mixerGetNumDevs() <> 0) Then
        '打开设备
        If mixerOpen(m_hMixer, 0, 0, 0, MIXER_OBJECTF_MIXER Or CALLBACK_WINDOW) <> MMSYSERR_NOERROR Then
            Exit Function
        End If
        '获取设备能力
        If mixerGetDevCaps(m_hMixer, m_Caps, Len(m_Caps)) <> MMSYSERR_NOERROR Then
            Exit Function
        End If
    End If
   
    '如果打开失败
    If m_hMixer = 0 Then Exit Function
   
    Dim mxl As MIXERLINE
    Dim mxc As MIXERCONTROL
    Dim mxlc As MIXERLINECONTROLS
    Dim hMem As Long
   
    hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxc))
   
    mxl.cbStruct = Len(mxl)
    mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
    If mixerGetLineInfo(m_hMixer, mxl, MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE) <> MMSYSERR_NOERROR Then
        Exit Function
    End If
   
    m_lDeviceNum = mxl.cChannels
   
    mxlc.cbStruct = Len(mxlc)
    mxlc.dwLineID = mxl.dwLineID
    mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
    mxlc.cControls = 1
    mxlc.cbmxctrl = Len(mxc)
    mxlc.pamxctrl = GlobalLock(hMem)
   
    If mixerGetLineControls(m_hMixer, mxlc, MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE) <> MMSYSERR_NOERROR Then
        GlobalUnlock hMem
        GlobalFree hMem
        Exit Function
    End If
   
    CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
    m_lDeviceID = mxc.dwControlID
    m_lMin = mxc.Bounds(1)
    m_lMax = mxc.Bounds(2)
   
    GlobalUnlock hMem
    GlobalFree hMem
    OpenDeviceForVolume = True
End Function

'打开设备以设置静音
Public Function OpenDeviceForMute() As Boolean
   
    OpenDeviceForMute = False
   
    '不懂
    If (mixerGetNumDevs() <> 0) Then
        '打开设备
        If mixerOpen(m_hMixer, 0, 0, 0, MIXER_OBJECTF_MIXER Or CALLBACK_WINDOW) <> MMSYSERR_NOERROR Then
            Exit Function
        End If
        '获取设备能力
        If mixerGetDevCaps(m_hMixer, m_Caps, Len(m_Caps)) <> MMSYSERR_NOERROR Then
            Exit Function
        End If
    End If
   
    '如果打开失败
    If m_hMixer = 0 Then Exit Function
   
    Dim mxl As MIXERLINE
    Dim mxc As MIXERCONTROL
    Dim mxlc As MIXERLINECONTROLS
    Dim hMem As Long
   
    hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxc))
   
    mxl.cbStruct = Len(mxl)
    mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
    If mixerGetLineInfo(m_hMixer, mxl, MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE) <> MMSYSERR_NOERROR Then
        Exit Function
    End If
   
    m_lDeviceNum = mxl.cChannels
   
    mxlc.cbStruct = Len(mxlc)
    mxlc.dwLineID = mxl.dwLineID
    mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_MUTE
    mxlc.cControls = 1
    mxlc.cbmxctrl = Len(mxc)
    mxlc.pamxctrl = GlobalLock(hMem)
   
    If mixerGetLineControls(m_hMixer, mxlc, MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE) <> MMSYSERR_NOERROR Then
        GlobalUnlock hMem
        GlobalFree hMem
        Exit Function
    End If
   
    CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
    m_lDeviceID = mxc.dwControlID

    GlobalUnlock hMem
    GlobalFree hMem
    OpenDeviceForMute = True
End Function

'关闭打开的设备
Public Function CloseDevice() As Boolean
    CloseDevice = False
   
    If m_hMixer <> 0 Then
        mixerClose m_hMixer
        m_hMixer = 0
    End If
   
    CloseDevice = True
End Function

'设置音量
Public Function SetVolume(ByVal lVol As Long, ByVal rVol As Long) As Boolean
    SetVolume = False
   
    '如果设备未打开
    If m_hMixer = 0 Then Exit Function
   
    Dim mxcdVolume As MIXERCONTROLDETAILS_SIGNED_ARRAY_2
    Dim mxcd As MIXERCONTROLDETAILS
    Dim hMem As Long
   
    hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdVolume))
   
    mxcdVolume.v1.lValue = lVol
    mxcdVolume.v2.lValue = rVol
    mxcd.cbStruct = Len(mxcd)
    mxcd.dwControlID = m_lDeviceID
    mxcd.cChannels = m_lDeviceNum
    mxcd.item = 0
    mxcd.cbDetails = Len(mxcdVolume.v1)
    mxcd.paDetails = GlobalLock(hMem)
    CopyPtrFromStruct mxcd.paDetails, mxcdVolume, Len(mxcdVolume)
   
    If mixerSetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
        GlobalUnlock (hMem)
        GlobalFree (hMem)
        Exit Function
    End If
   
    GlobalUnlock (hMem)
    GlobalFree (hMem)
    SetVolume = True
End Function

'获取当前音量
Public Function GetVolume(ByRef lVol As Long, ByRef rVol As Long) As Boolean
   
    GetVolume = False
    lVol = -1
    rVol = -1
   
    '如果设备未打开
    If m_hMixer = 0 Then Exit Function
   
    Dim mxcdVolume As MIXERCONTROLDETAILS_SIGNED_ARRAY_2
    Dim mxcd As MIXERCONTROLDETAILS
    Dim hMem As Long
   
    hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdVolume))
   
    mxcd.cbStruct = Len(mxcd)
    mxcd.dwControlID = m_lDeviceID
    mxcd.cChannels = m_lDeviceNum
    mxcd.item = 0
    mxcd.cbDetails = Len(mxcdVolume.v1)
    mxcd.paDetails = GlobalLock(hMem)
   
    If mixerGetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
        GlobalUnlock (hMem)
        GlobalFree (hMem)
        Exit Function
    End If
   
    CopyStructFromPtr mxcdVolume, mxcd.paDetails, Len(mxcdVolume)
   
    lVol = mxcdVolume.v1.lValue
    If m_lDeviceNum = 2 Then
        rVol = mxcdVolume.v2.lValue
    End If
   
    GlobalUnlock (hMem)
    GlobalFree (hMem)
    GetVolume = True
End Function

'获取当前是否静音状态
Public Function GetMute(ByRef bMute As Boolean) As Boolean
    GetMute = False
   
    If m_hMixer = 0 Then Exit Function
   
    Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN
    Dim mxcd As MIXERCONTROLDETAILS
    mxcd.cbStruct = Len(mxcd)
    mxcd.dwControlID = m_lDeviceID
    mxcd.cChannels = 1
    mxcd.item = 0
    mxcd.cbDetails = Len(mxcdMute)
    mxcd.paDetails = VarPtr(mxcdMute)
    If mixerGetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
        Exit Function
    End If
   
    If mxcdMute.fValue <> 0 Then
        bMute = True
    Else
        bMute = False
    End If
   
    GetMute = True
End Function

'设置静音
'参数为是否静音.
Public Function SetMute(ByVal bMute As Boolean) As Boolean
    SetMute = False
   
    If m_hMixer = 0 Then Exit Function
   
    Dim hMem As Long
    Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN
    Dim mxcd As MIXERCONTROLDETAILS
   
    mxcdMute.fValue = IIf(bMute, 1, 0)
    hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdMute.fValue))
   
    mxcd.cbStruct = Len(mxcd)
    mxcd.dwControlID = m_lDeviceID
    mxcd.cChannels = 1
    mxcd.item = 0
    mxcd.cbDetails = Len(mxcdMute)
    mxcd.paDetails = GlobalLock(hMem)
   
    CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)

    If mixerSetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
        GlobalUnlock hMem
        GlobalFree hMem
        Exit Function
    End If
   
    GlobalUnlock hMem
    GlobalFree hMem
    SetMute = True
End Function

'获取最大音量
Public Function GetMaxVolume() As Long
    GetMaxVolume = IIf(m_hMixer = 0, -1, m_lMax)
End Function

'获取最小音量
Public Function GetMinVolume() As Long
    GetMinVolume = IIf(m_hMixer = 0, -1, m_lMin)
End Function

Private Sub Class_Initialize()
    m_hMixer = 0
    m_lMax = -1
    m_lMin = -1
End Sub