Public Const HIGHEST_VOLUME_SETTING = 12'Put these into a module
'  device ID for aux device mapper
Public Const AUX_MAPPER = -1&
Public Const MAXPNAMELEN = 32Type AUXCAPS
       wMid As Integer
       wPid As Integer
       vDriverVersion As Long
       szPname As String * MAXPNAMELEN
       wTechnology As Integer
       dwSupport As Long
End Type'  flags for wTechnology field in AUXCAPS structure
Public Const AUXCAPS_CDAUDIO = 1  '  audio from internal CD-ROM drive
Public Const AUXCAPS_AUXIN = 2  '  audio from auxiliary input jacks'  flags for dwSupport field in AUXCAPS structure
Public Const AUXCAPS_VOLUME = &H1         '  supports volume control
Public Const AUXCAPS_LRVOLUME = &H2         '  separate left-right volume controlDeclare Function auxGetNumDevs Lib "winmm.dll" () As Long
Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As LongDeclare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByRef lpdwVolume As Long) As Long
Declare Function auxOutMessage Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long'****************************************************************************
'* Possible Return values from auxGetVolume, auxSetVolume                   *
'****************************************************************************
Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)'****************************************************************************
'* Use the CopyMemory function from the Windows API                         *
'****************************************************************************
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)'****************************************************************************
'* Use this structure to break the Long into two Integers                   *
'****************************************************************************
Public Type VolumeSetting
    LeftVol As Integer
    RightVol As Integer
End TypeSub lCrossFader()
'Vol1 = 100 - Slider1.Value ' Left
'Vol2 = 100 - Slider5.Value ' Right
'E = CrossFader.Value
'F = 100 - E
'If Check4.Value = 1 Then ' Half Fader Check
'    LVol = (F * Val(Vol1) / 100) * 2
'    RVol = (E * Val(Vol2) / 100) * 2
'    If LVol > (50 * Val(Vol1) / 100) * 2 Then
'        LVol = (50 * Val(Vol1) / 100) * 2
'    End If
'    If RVol > (50 * Val(Vol2) / 100) * 2 Then
'        RVol = (50 * Val(Vol2) / 100) * 2
'    End If
'Else
'    LVol = (F * Val(Vol1) / 100)
'    RVol = (E * Val(Vol2) / 100)
'End If
'Label1.Caption = "Fader: " + LTrim$(Str$(LVol)) + " x " + LTrim$(Str$(RVol))
'
End Sub
Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
'****************************************************************************
'* This function sets the current Windows volume settings to the specified  *
'* device using two Custom numbers from 0 to HIGHEST_VOLUME_SETTING for the *
'* right and left volume settings.                                          *
'*                                                                          *
'* The return value of this function is the Return value of the auxGetVolume*
'* Windows API call.                                                        *
'****************************************************************************    Dim bReturnValue As Boolean                     ' Return Value from Function
    Dim Volume As VolumeSetting                     ' Type structure used to convert a long to/from
                                                    ' two Integers.
                                                    
    Dim lAPIReturnVal As Long                       ' Return value from API Call
    Dim lBothVolumes As Long                        ' The API passed value of the Combined Volumes
    
    
'****************************************************************************
'* Calculate the Integers                                                   *
'****************************************************************************
    Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
    Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
    
'****************************************************************************
'* Combine the Integers into a Long to be Passed to the API                 *
'****************************************************************************
    lDataLen = Len(Volume)
    CopyMemory lBothVolumes, Volume.LeftVol, lDataLen'****************************************************************************
'* Set the Value to the API                                               *
'****************************************************************************
    lAPIReturnVal = auxSetVolume(lDeviceID, lBothVolumes)
    lSetVolume = lAPIReturnValEnd Function

解决方案 »

  1.   


    Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
    '****************************************************************************
    '* This function reads the current Windows volume settings from the         *
    '* specified device, and returns two numbers from 0 to                      *
    '* HIGHEST_VOLUME_SETTING for the right and left volume settings.           *
    '*                                                                          *
    '* The return value of this function is the Return value of the auxGetVolume*
    '* Windows API call.                                                        *
    '****************************************************************************    Dim bReturnValue As Boolean                     ' Return Value from Function
        Dim Volume As VolumeSetting                     ' Type structure used to convert a long to/from
                                                        ' two Integers.
        Dim lAPIReturnVal As Long                       ' Return value from API Call
        Dim lBothVolumes As Long                        ' The API Return of the Combined Volumes
        
    '****************************************************************************
    '* Get the Value from the API                                               *
    '****************************************************************************
        lAPIReturnVal = auxGetVolume(lDeviceID, lBothVolumes)
        
    '****************************************************************************
    '* Split the Long value returned from the API into to Integers              *
    '****************************************************************************
        lDataLen = Len(Volume)
        CopyMemory Volume.LeftVol, lBothVolumes, lDataLen
        
    '****************************************************************************
    '* Calculate the Return Values.                                             *
    '****************************************************************************
        lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
        lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535    lGetVolume = lAPIReturnVal
    End FunctionPublic Function nSigned(ByVal lUnsignedInt As Long) As Integer
        Dim nReturnVal As Integer                          ' Return value from Function
        
        If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
            MsgBox "Error in conversion from Unsigned to nSigned Integer"
            nSignedInt = 0
            Exit Function
        End If    If lUnsignedInt > 32767 Then
            nReturnVal = lUnsignedInt - 65536
        Else
            nReturnVal = lUnsignedInt
        End If
        
        nSigned = nReturnValEnd FunctionPublic Function lUnsigned(ByVal nSignedInt As Integer) As Long
        Dim lReturnVal As Long                          ' Return value from Function
        
        If nSignedInt < 0 Then
            lReturnVal = nSignedInt + 65536
        Else
            lReturnVal = nSignedInt
        End If
        
        If lReturnVal > 65535 Or lReturnVal < 0 Then
            MsgBox "Error in conversion from nSigned to Unsigned Integer"
            lReturnVal = 0
        End If
        
        lUnsigned = lReturnVal
    End Function
      

  2.   

    楼上代码我有,但不知怎么用,lDeviceID不知怎么取得,更主要的是我想用我的思路求解,就是上面的那个C代码的方法,如果能把它改在VB代码就好了,因为我差不多以弄懂它的思路,
    C代码中:MIXERLINECONTROLS结构中有 dwControlType,而VB代码中却没有,我照搬出了错,不照搬却又不能取得正确结果。我气呀,真的没有高手了吗?
      

  3.   

    打开C的头文件,找到声明,改成VB的就可以
      

  4.   

    楼上说的,恐怕不行啊 VB中没有dwControlType,我试过,不行
      

  5.   

    感谢您使用微软产品!下面文章中的例子包含了API函数mixerGetControlDetails的VB代码。
    控制系统声音功能的相关函数有:
    mixerClose - 关闭指定的混音设备
    mixerOpen – 打开指定的混音设备
    mixerGetDevCaps – 查询指定混音设备的声音大小范围
    mixerGetID – 检索与指定设备句柄相关的混音器的设备ID
    mixerSetControlDetails – 设置单一音频线的属性
    mixerGetControlDetails – 检索单一音频线的详细信息Q178456 SAMPLE: Volume.exe: Set Volume Control Levels Using Visual Basic
    http://support.microsoft.com/support/kb/articles/q178/4/56.asp- 微软全球技术中心 VB技术支持本贴子以“现状”提供且没有任何担保,同时也没有授予任何权利。具体事项可参见使用条款(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。为了为您创建更好的讨论环境,请参加我们的用户满意度调查(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。======================
    -