怎样有vb控制windows系统的声道，在线，解决就给分！

Question

用setvolum()(好像是这样写吧,查查msdn),当中由一个决定window 声音的大小,在这个long 类型的参数中高字节是左声道声音的大小,低字节是右声道的大小,不同的值就能控制声道的偏移.
具体看看msdn.

Answer 1

FORM中的代码，注意加两个滚动条Option ExplicitPrivate Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As LongPrivate LVolume As Long
Private RVolume As Long
Private blnIsChanged As BooleanPrivate Sub GetLRVolumne()
    Dim i, j As Long
    
    i = waveOutGetVolume(0, j)    LVolume = j And &HFFFF&
    RVolume = ((j And &HFFFF0000) / &H10000) And &HFFFF&
    
    Debug.Print LVolume
    Debug.Print RVolume
    Debug.Print "&H" & Hex(j)
    
    blnIsChanged = True
    VScroll1(0).Value = -LVolume + 32768 - 1
    VScroll1(1).Value = -RVolume + 32768 - 1
        
    Label2(0).Caption = LVolume '- 32768
    Label2(1).Caption = RVolume '- 32768
End SubPrivate Sub Timer1_Timer()
    GetLRVolumne
End SubPrivate Sub Form_Load()
    VScroll1(0).Max = 32767
    VScroll1(0).Min = -32768
    VScroll1(1).Max = 32767
    VScroll1(1).Min = -32768
    
    GetLRVolumne
End SubPrivate Sub VScroll1_Change(Index As Integer)
    If blnIsChanged Then
        blnIsChanged = False
        Exit Sub
    End If
    
    Dim a As String
    Dim i, j As Long
    
    a = Hex(32768 - VScroll1(0).Value - 1)
    Select Case Len(a)
    Case 1
        a = "000" & a
    Case 2
        a = "00" & a
    Case 3
        a = "0" & a
    End Select
    
    a = "&H" & Hex(32768 - VScroll1(1).Value - 1) & a
    Debug.Print a
    
    j = CLng(a)
    i = waveOutSetVolume(0, j)
End SubPrivate Sub VScroll1_Scroll(Index As Integer)
    Dim a As String
    Dim i, j As Long
    
    a = Hex(32768 - VScroll1(0).Value - 1)
    Select Case Len(a)
    Case 1
        a = "000" & a
    Case 2
        a = "00" & a
    Case 3
        a = "0" & a
    End Select
    
    a = "&H" & Hex(32768 - VScroll1(1).Value - 1) & a
    Debug.Print a
    
    j = CLng(a)
    i = waveOutSetVolume(0, j)
End Sub
以下是MODULE中的代码
Option Explicit' 将16进制字符串转换为长整形 WY-2002-10-09
' strHex 要转换的16进制字符串
Public Function HexToLong(strHex As String) As Long
    Dim lngCount As Long
    Dim a As Long
    
    If strHex = "" Then
        HexToLong = -1
        Exit Function
    End If
    
    For lngCount = 1 To Len(strHex)
        a = aa(Mid(strHex, Len(strHex) - lngCount + 1, 1), lngCount)
        HexToLong = HexToLong + a
    Next lngCount
End Function' 根据数位和数值计算出十进制值 WY-2002-10-09
' strHex 当前数值
' lngDigit 当前数值所在的数位
Public Function aa(strHex As String, lngDigit As Long) As Long
    Dim lngTmp As Long
    
    Select Case UCase(strHex)
    Case "A"
        lngTmp = 10
    Case "B"
        lngTmp = 11
    Case "C"
        lngTmp = 12
    Case "D"
        lngTmp = 13
    Case "E"
        lngTmp = 14
    Case "F"
        lngTmp = 15
    Case Else
        lngTmp = CLng(strHex)
    End Select
    
    aa = 16 ^ (lngDigit - 1) * lngTmp
End Function

Answer 2

radio是什么 是控件吗？如果是怎样引用。
请详细一些。还没解决呢。

Answer 3

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 = 32
Type 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 control
Declare 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 Long
Declare 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 Type
Sub 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 = lAPIReturnVal
End Function
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 Function
Public 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 = nReturnVal
End Function
Public 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

Answer 4

Public Sub SetVolTrack(i As Long) '声道控制
Select Case i
Case 0 '静音
mciSendString "set all audio all off", vbNullString, 0, form2.hwnd
Case 1 '左声道
mciSendString "set all audio all off", vbNullString, 0, form2.hwnd
mciSendString "set all audio left on", vbNullString, 0, form2.hwnd
Case 2 '右声道
mciSendString "set all audio all off", vbNullString, 0, form2.hwnd
mciSendString "set all audio right on", vbNullString, 0, form2.hwnd
Case 3 '立体声
mciSendString "set all audio all off", vbnullsting, 0, form2.hwnd
mciSendString "set all audio left on", vbNullString, 0, form2.hwnd
mciSendString "set all audio right on", vbNullString, 0, form2.hwnd
End Select
End Sub