'VB源程序以下: '1.modu1.bas '2.form1.frm '3.三个过程 '一、---------------modu1.bas Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long Private Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long Private 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 Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Type VolumeSetting LeftVol As Integer RightVol As Integer End TypePublic Const HIGHEST_VOLUME_SETTING = 12 Public Const WAVE_MAPPER = -1&'下面是获取音量的函数: Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long Dim bReturnValue As Boolean Dim Volume As VolumeSetting Dim lAPIReturnVal As Long Dim lBothVolumes As Long lAPIReturnVal = waveOutGetVolume(lDeviceID, lBothVolumes) lDataLen = Len(Volume) CopyMemory Volume.LeftVol, lBothVolumes, lDataLen lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535 lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535 lGetVolume = lAPIReturnVal End Function'下面是设置音量的函数: Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long Dim bReturnValue As Boolean Dim Volume As VolumeSetting Dim lAPIReturnVal As Long Dim lBothVolumes As Long Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING) Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING) lDataLen = Len(Volume) CopyMemory lBothVolumes, Volume.LeftVol, lDataLen lAPIReturnVal = waveOutSetVolume(lDeviceID, lBothVolumes) lSetVolume = lAPIReturnVal End Function'** -> * 转换函数 Public Function nSigned(ByVal lUnsignedInt As Long) As Integer Dim nReturnVal As Integer 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 If nSignedInt < 0 Then lReturnVal = nSignedInt + 65536 Else lReturnVal = nSignedInt End IfIf lReturnVal > 65535 Or lReturnVal < 0 Then MsgBox "Error in conversion from nSigned to Unsigned Integer" lReturnVal = 0 End If lUnsigned = lReturnValEnd Function '二、---------------form1.frm Private Sub cmd_Chancel_Click() '改变声道的按钮 caption='9左声' 'Sound PROC If cmd_Chancel.Caption = "9立体" Then cmd_Chancel.Caption = "9左声" Call cmd_right_0_Click Exit Sub End If If cmd_Chancel.Caption = "9左声" Then cmd_Chancel.Caption = "9右声" Call cmd_left_0_Click Exit Sub End If If cmd_Chancel.Caption = "9右声" Then cmd_Chancel.Caption = "9立体" Call cmd_left_right_Click Exit Sub End If End Sub'三、---------------三个过程 Private Sub cmd_right_0_Click() Dim L As Long, lleft As Long, lright As Longlleft = lUnsigned(HIGHEST_VOLUME_SETTING) lright = lUnsigned(0)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub Private Sub cmd_left_0_Click() Dim L As Long, lleft As Long, lright As Longlleft = lUnsigned(0) lright = lUnsigned(HIGHEST_VOLUME_SETTING)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub Private Sub cmd_left_right_Click() Dim L As Long, lleft As Long, lright As Long lleft = lUnsigned(12) lright = lUnsigned(12)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub '------------------完
Public Sub SetBalance(mValue As Long) Dim z As Long Dim MxDetails As MIXERCONTROLDETAILS Dim MxVolume(1) As MIXERCONTROLDETAILS_UNSIGNED Dim volL As Long, volR As Long, tmpVol As Long tmpVol = slVolume.Max - slVolume.Value tmpVol = IIf(tmpVol = 0, 655, tmpVol) volR = tmpVol * (IIf(mValue >= 0, 1, (100 + mValue) / 100)) volL = tmpVol * (IIf(mValue <= 0, 1, (100 - mValue) / 100)) MxDetails.item = Mix_Ctl.cMultipleItems MxDetails.dwControlID = Mix_Ctl.dwControlID MxDetails.cbStruct = Len(MxDetails) MxDetails.cbDetails = Len(MxVolume(0)) MxDetails.cChannels = 2 hmem = GlobalAlloc(&H40, Len(MxVolume(0))) MxDetails.paDetails = GlobalLock(hmem) MxVolume(1).dwValue = volR MxVolume(0).dwValue = volL 'two channels CopyPtrFromStruct MxDetails.paDetails, MxVolume(1).dwValue, Len(MxVolume(0)) * MxDetails.cChannels CopyPtrFromStruct MxDetails.paDetails, MxVolume(0).dwValue, Len(MxVolume(1)) * MxDetails.cChannels z = mixerSetControlDetails(m_Mixer, MxDetails, MIXER_SETCONTROLDETAILSF_VALUE) GlobalFree hmem End Sub Public Declare Function mixerClose Lib "winmm.dll" (ByVal hmx 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 mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long Public Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId 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 mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long Public Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long Public Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 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 mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long 'Memory API Public Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long) Public Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long) Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
'1.modu1.bas
'2.form1.frm
'3.三个过程
'一、---------------modu1.bas
Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private 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 Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Type VolumeSetting
LeftVol As Integer
RightVol As Integer
End TypePublic Const HIGHEST_VOLUME_SETTING = 12
Public Const WAVE_MAPPER = -1&'下面是获取音量的函数:
Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
Dim bReturnValue As Boolean
Dim Volume As VolumeSetting
Dim lAPIReturnVal As Long
Dim lBothVolumes As Long
lAPIReturnVal = waveOutGetVolume(lDeviceID, lBothVolumes)
lDataLen = Len(Volume)
CopyMemory Volume.LeftVol, lBothVolumes, lDataLen
lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535
lGetVolume = lAPIReturnVal
End Function'下面是设置音量的函数:
Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
Dim bReturnValue As Boolean
Dim Volume As VolumeSetting
Dim lAPIReturnVal As Long
Dim lBothVolumes As Long
Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
lDataLen = Len(Volume)
CopyMemory lBothVolumes, Volume.LeftVol, lDataLen
lAPIReturnVal = waveOutSetVolume(lDeviceID, lBothVolumes)
lSetVolume = lAPIReturnVal
End Function'** -> * 转换函数
Public Function nSigned(ByVal lUnsignedInt As Long) As Integer
Dim nReturnVal As Integer
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
If nSignedInt < 0 Then
lReturnVal = nSignedInt + 65536
Else
lReturnVal = nSignedInt
End IfIf lReturnVal > 65535 Or lReturnVal < 0 Then
MsgBox "Error in conversion from nSigned to Unsigned Integer"
lReturnVal = 0
End If
lUnsigned = lReturnValEnd Function
'二、---------------form1.frm
Private Sub cmd_Chancel_Click() '改变声道的按钮 caption='9左声'
'Sound PROC
If cmd_Chancel.Caption = "9立体" Then
cmd_Chancel.Caption = "9左声"
Call cmd_right_0_Click
Exit Sub
End If
If cmd_Chancel.Caption = "9左声" Then
cmd_Chancel.Caption = "9右声"
Call cmd_left_0_Click
Exit Sub
End If
If cmd_Chancel.Caption = "9右声" Then
cmd_Chancel.Caption = "9立体"
Call cmd_left_right_Click
Exit Sub
End If
End Sub'三、---------------三个过程
Private Sub cmd_right_0_Click()
Dim L As Long, lleft As Long, lright As Longlleft = lUnsigned(HIGHEST_VOLUME_SETTING)
lright = lUnsigned(0)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub
Private Sub cmd_left_0_Click()
Dim L As Long, lleft As Long, lright As Longlleft = lUnsigned(0)
lright = lUnsigned(HIGHEST_VOLUME_SETTING)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub
Private Sub cmd_left_right_Click()
Dim L As Long, lleft As Long, lright As Long
lleft = lUnsigned(12)
lright = lUnsigned(12)L = lSetVolume(lleft, lright, WAVE_MAPPER)End Sub
'------------------完
Dim z As Long
Dim MxDetails As MIXERCONTROLDETAILS
Dim MxVolume(1) As MIXERCONTROLDETAILS_UNSIGNED
Dim volL As Long, volR As Long, tmpVol As Long
tmpVol = slVolume.Max - slVolume.Value
tmpVol = IIf(tmpVol = 0, 655, tmpVol)
volR = tmpVol * (IIf(mValue >= 0, 1, (100 + mValue) / 100))
volL = tmpVol * (IIf(mValue <= 0, 1, (100 - mValue) / 100))
MxDetails.item = Mix_Ctl.cMultipleItems
MxDetails.dwControlID = Mix_Ctl.dwControlID
MxDetails.cbStruct = Len(MxDetails)
MxDetails.cbDetails = Len(MxVolume(0))
MxDetails.cChannels = 2
hmem = GlobalAlloc(&H40, Len(MxVolume(0)))
MxDetails.paDetails = GlobalLock(hmem)
MxVolume(1).dwValue = volR
MxVolume(0).dwValue = volL
'two channels
CopyPtrFromStruct MxDetails.paDetails, MxVolume(1).dwValue, Len(MxVolume(0)) * MxDetails.cChannels
CopyPtrFromStruct MxDetails.paDetails, MxVolume(0).dwValue, Len(MxVolume(1)) * MxDetails.cChannels
z = mixerSetControlDetails(m_Mixer, MxDetails, MIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree hmem
End Sub
Public Declare Function mixerClose Lib "winmm.dll" (ByVal hmx 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 mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long
Public Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId 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 mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Public Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 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 mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
'Memory API
Public Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Public Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
[email protected]
你下载这个好了,一样的:
http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=21757&strZipAccessCode=ODE%5F217575431