怎样调节音量？

[rushing]

自如调整Windows的播放音量。

[JYQing]

我有一个例子，你要吗？

[h_x_k]

http://ecom.xj169.net/vbgood/download/code/vol.zip

[wxj_lake]

音量控制器
http://210.75.132.33/lakes/detail.asp?id=80

[wxj_lake]

　　音量控制模块，简单控制 Windows 的主音量，更详细内容请察看音量控制器。


'****************************************************************************
'* This constant holds the value of the Highest Custom volume setting.　The *
'* lowest value will always be zero.　　　　　　　　　　　　　　　　　　　　*
'****************************************************************************
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

[rushing]

有没有VB6 的例子呀？

[dragonleon]

楼上那位写的是VB的例程啊！是API函数

[rushing]

怎样调用这个API呀？

[windsandy]

Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
uDeviceID 设备号
dwVolume 音量大小值
loword 左声道 hiword 右声道
0x0000 最小值 0xffff最大值

[limengchen]

程序在你的邮箱中。

[rushing]

这个程序在笔记本电脑上不能用。
总是出现“EQpro.dll过期”的错误。
我该怎么办？
急！！

[HelloAllen]

limengchen(lmc)能不能给我也发一份程序?谢谢！