volume.bas

一个mp3播放器的源码

Attribute VB_Name = "Volume"
Option Explicit

Private Const MAXPNAMELEN = 32
Private Const MMSYSERR_NOERROR = 0

Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&

Private Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Private Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN = &H0&
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000

Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
    (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)

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 Declare Function mixerGetLineControls Lib "winmm.dll" _
    Alias "mixerGetLineControlsA" _
    (ByVal hmxobj As Long, _
    pmxlc As MIXERLINECONTROLS, _
    ByVal fdwControls 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 mixerGetControlDetails Lib "winmm.dll" _
    Alias "mixerGetControlDetailsA" _
    (ByVal hmxobj As Long, _
    pMxcd As MIXERCONTROLDETAILS, _
    ByVal fdwDetails As Long) As Long
    
Private Declare Sub CopyStructFromPtr Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (struct As Any, _
    ByVal ptr As Long, ByVal cb As Long)
                     
Private Declare Sub CopyPtrFromStruct Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (ByVal ptr As Long, _
    struct As Any, _
    ByVal cb As Long)
                     
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 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 MIXERCONTROLDETAILS
    cbStruct As Long
    dwControlID As Long
    cChannels As Long
    item As Long
    cbDetails As Long
    paDetails As Long
End Type
      

Private Type MIXERCONTROLDETAILS_BOOLEAN
    fValue 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 Type MIXERLINECONTROLS
    cbStruct As Long
    dwLineID As Long
    dwControl As Long
    cControls As Long
    cbmxctrl As Long
    pamxctrl As Long
End Type

Private Type MIXERCONTROLDETAILS_UNSIGNED
    dwValue As Long
End Type

Public hmixer As Long
Public volMute As MIXERCONTROL
Public volCtrl As MIXERCONTROL

Private rc As Long
Private ok As Boolean

Private Sub Class_Initialize()  '初始化

    ok = GetVolumeControl(hmixer, _
        MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
        MIXERCONTROL_CONTROLTYPE_VOLUME, _
        volCtrl)
        
    ok = GetVolumeControl(hmixer, _
        MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
        MIXERCONTROL_CONTROLTYPE_MUTE, _
        volMute)
End Sub
Private Function GetVolumeControl(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
        mxlc.cbStruct = Len(mxlc)
        mxlc.dwLineID = mxl.dwLineID
        mxlc.dwControl = ctrlType
        mxlc.cControls = 1
        mxlc.cbmxctrl = Len(mxc)
             
        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
            GetVolumeControl = True
                 
            CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
        Else
            GetVolumeControl = False
        End If
        GlobalFree (hmem)
        Exit Function
    End If
      
    GetVolumeControl = False
End Function

Function SetMute(mxc As MIXERCONTROL, ByVal Mute As Boolean) '静音
                              
    Dim mxcd As MIXERCONTROLDETAILS
    Dim Mut As MIXERCONTROLDETAILS_BOOLEAN
    Dim hmem As Long
      
    Class_Initialize
    
    mxcd.item = 0
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(Mut)
    
    hmem = GlobalAlloc(&H40, Len(Mut))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1
    Mut.fValue = IIf(Mute, 1, 0)
         
    CopyPtrFromStruct mxcd.paDetails, Mut, Len(Mut)
         
    rc = mixerSetControlDetails(hmixer, _
        mxcd, _
        MIXER_SETCONTROLDETAILSF_VALUE)
    
    GlobalFree (hmem)
End Function

Function SetVolume(ByVal hmixer As Long, _
                              mxc As MIXERCONTROL, _
                              ByVal volume As Long) As Boolean  '设置系统音量
                              
    Dim mxcd As MIXERCONTROLDETAILS
    Dim vol As MIXERCONTROLDETAILS_UNSIGNED
    Dim hmem As Long
    
    Class_Initialize
    
    mxcd.item = 0
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(vol)
         
    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1
    vol.dwValue = volume
         
    CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
         
    rc = mixerSetControlDetails(hmixer, _
        mxcd, _
        MIXER_SETCONTROLDETAILSF_VALUE)
         
    GlobalFree (hmem)
    If (MMSYSERR_NOERROR = rc) Then
        SetVolume = True
    Else
        SetVolume = False
    End If
End Function

 Function GetVolume(mxc As MIXERCONTROL) As Long    '获得系统音量
                              
    Dim mxcd As MIXERCONTROLDETAILS
    Dim vol As MIXERCONTROLDETAILS_UNSIGNED
    Dim hmem As Long
    
    Class_Initialize
    
    mxcd.item = 0
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(vol)
    
    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1
         
    rc = mixerGetControlDetails(hmixer, _
        mxcd, MIXER_GETCONTROLDETAILSF_VALUE)
    
    CopyStructFromPtr vol, mxcd.paDetails, Len(vol)
    
    GetVolume = vol.dwValue
    
    GlobalFree (hmem)
    
End Function