Attribute VB_Name = "Common"
''
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Any) As Long
Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
'''
Public Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Public 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
Public Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Public Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Public Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Public Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Public Declare Sub CopyMemtoPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Sub CopyMemtoVar Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Any, ByVal Length As Long)

Public Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4&
Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001

Type MIXERCONTROLDETAILS
    cbStruct As Long       '  MIXERCONTROLDETAILS结构的字节数
    dwControlID As Long    '  标志mixer的一个设备的虚拟句柄，用来读/写DETAILS
    cChannels As Long      '  通道数
    item As Long           '  每个通道的元素数
    cbDetails As Long      '  存放sdetails结构的字节数
    paDetails As Long      '  指向存放sdetails结构的指针
End Type

Type MIXERLINE
    cbStruct As Long               '  MIXERLINE结构的字节数
    dwDestination As Long          '  Audio目标线路的索引
    dwSource As Long               '  Audio源线路的索引
    dwLineID As Long               '  唯一的线路标志
    fdwLine As Long                '  线路的状态信息
    dwUser As Long                 '  该线路的Audio设备信息
    dwComponentType As Long        '  线路的连接成分
    cChannels As Long              '  最大通道数
    cConnections As Long           '  可能的连接数
    cControls As Long              '  该线路上的控制数
    szShortName As String * 16     '  该线路的短名称
    szName As String * 64          '  该线路的全名称
    dwType As Long
    dwDeviceID As Long
    wMid  As Integer
    wPid As Integer
    vDriverVersion As Long
    szPname As String * 32
End Type

Type MIXERLINECONTROLS
    cbStruct As Long       '  MIXERLINECONTROLS结构的字节数
    dwLineID As Long       '  线路标志
    dwControl As Long      '  标志mixer的一个设备的虚拟句柄
    cControls As Long      '  MIXERCONTROL的数目
    cbmxctrl As Long       '  每个MIXERCONTROL结构的字节数
    pamxctrl As Long       '  指向第一个MIXERCONTROL结构的指针
End Type

Type MIXERCONTROL
    cbStruct As Long            '  MIXERCONTROL结构的字节数
    dwControlID As Long         '  标志mixer的一个设备的虚拟句柄
    dwControlType As Long       '  该控制的类型
    fdwControl As Long          '  该控制的类型的状态
    cMultipleItems As Long      '  每个通道的元素数
    szShortName As String * 16  '  该控制的短名称
    szName As String * 64       '  该控制的长名称
    lMinimum As Long            '  最小值
    lMaximum As Long            '  最大值
    reserved(10) As Long        '  保留
End Type

Type VOLUME
    dwVolmue1 As Long
    dwVolmue2 As Long
End Type

Type VOLUME_LR
    dwLVol As Integer
    dwRVol As Integer
End Type
    
Public Function Exec_MciCmd(ByVal cmd As String, Optional ByRef lpRet As String) As Long
'Exec_MciCmd函数主要实现一下功能
    '如果MCI执行成功，pRet返回命令读取内容，否则返回错误的文字信息。
    '函数返回的是错误码，执行成功为0。
    Dim lpRetStr As String * 128
    Dim nPos As Integer
    Dim errCode As Long
    On Error Resume Next
    errCode = mciSendString(cmd, lpRetStr, 128, 0)
    If errCode Then
        '获得错误的文字信息
        mciGetErrorString errCode, lpRetStr, 128
    End If
    '如果执行成功，lpRet返回命令读取内容，否则返回错误的文字信息。
    nPos = InStr(lpRetStr, Chr(0))
    lpRet = Left(lpRetStr, nPos - 1)
    Exec_MciCmd = errCode
End Function

Public Function GetSpeakerControl(ByVal hmxobj As Long, 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 = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
    ' 获得扬声器的成分类型
    rc = mixerGetLineInfo(hmxobj, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
    
    If rc <> 0 Then
        GetSpeakerControl = False
        Exit Function
    End If
    mxlc.cbStruct = Len(mxlc)
    mxlc.dwLineID = mxl.dwLineID
    mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
    mxlc.cControls = 1
    mxlc.cbmxctrl = Len(mxc)
    '为存放读取数据分配空间
    hmem = GlobalAlloc(&H40, Len(mxc))
    mxlc.pamxctrl = GlobalLock(hmem)
    mxc.cbStruct = Len(mxc)
    '获得扬声器的有关信息
    rc = mixerGetLineControls(hmxobj, _
                              mxlc, _
                              MIXER_GETLINECONTROLSF_ONEBYTYPE)
    CopyMemtoVar mxc, mxlc.pamxctrl, Len(mxc)  '复制读取数据
    GlobalFree (hmem)
    GetSpeakerControl = (0 = rc)
End Function

Public Function GetControlVolume(ByVal hmxobj As Long, ByVal CtrlID As Long, Vol As VOLUME) As Boolean
    Dim mixdl As MIXERCONTROLDETAILS
    Dim hmem As Long
    Dim rc As Long
    mixdl.cbStruct = Len(mixdl)
    mixdl.cbDetails = Len(Vol)
    mixdl.dwControlID = CtrlID
    mixdl.cChannels = 2     '读取2个通道
    '为存放读取数据分配空间
    hmem = GlobalAlloc(&H40, Len(Vol))
    mixdl.paDetails = GlobalLock(hmem)
    rc = mixerGetControlDetails(hmxobj, mixdl, MIXER_SETCONTROLDETAILSF_VALUE)
    CopyMemtoVar Vol, mixdl.paDetails, Len(Vol)  '复制读取数据
    GlobalFree (hmem)
    GetControlVolume = (0 = rc)
End Function


Public Function SetControlVolume(ByVal hmxobj As Long, ByVal CtrlID As Long, Vol As VOLUME) As Boolean
    Dim mixdl As MIXERCONTROLDETAILS
    Dim hmem As Long
    Dim rc As Long
    mixdl.cbStruct = Len(mixdl)
    mixdl.cbDetails = Len(Vol)
    mixdl.dwControlID = CtrlID
    mixdl.cChannels = 2     '设置2个通道
    ' 为存放设置数据分配空间
    hmem = GlobalAlloc(&H40, Len(Vol))
    mixdl.paDetails = GlobalLock(hmem)
    CopyMemtoPtr mixdl.paDetails, Vol, Len(Vol)  '复制设置数据
    rc = mixerSetControlDetails(hmxobj, mixdl, MIXER_SETCONTROLDETAILSF_VALUE)
    GlobalFree (hmem)
    SetControlVolume = (0 = rc)
End Function

