如何控制系统音量

->'thankstoRickRatayczakofFutureWorksMedia(rickr@execpc.com)
'savefileandrenamethemto[name].BAS

AttributeVB_Name="MIXER"
'****************************************************************************
'*ThisconstantholdsthevalueoftheHighestCustomvolumesetting.The*
'*lowestvaluewillalwaysbezero.*
'****************************************************************************
PublicConstHIGHEST_VOLUME_SETTING=12

'Puttheseintoamodule
'deviceIDforauxdevicemapper
PublicConstAUX_MAPPER=-1&
PublicConstMAXPNAMELEN=32

TypeAUXCAPS
wMidAsInteger
wPidAsInteger
vDriverVersionAsLong
szPnameAsString*MAXPNAMELEN
wTechnologyAsInteger
dwSupportAsLong
EndType

'flagsforwTechnologyfieldinAUXCAPSstructure
PublicConstAUXCAPS_CDAUDIO=1'audiofrominternalCD-ROMdrive
PublicConstAUXCAPS_AUXIN=2'audiofromauxiliaryinputjacks

'flagsfordwSupportfieldinAUXCAPSstructure
PublicConstAUXCAPS_VOLUME=&H1'supportsvolumecontrol
PublicConstAUXCAPS_LRVOLUME=&H2'separateleft-rightvolumecontrol

DeclareFunctionauxGetNumDevsLib"winmm.dll"()AsLong
DeclareFunctionauxGetDevCapsLib"winmm.dll"Alias"auxGetDevCapsA"(ByValuDeviceIDAsLong,lpCapsAsAUXCAPS,ByValuSizeAsLong)AsLong

DeclareFunctionauxSetVolumeLib"winmm.dll"(ByValuDeviceIDAsLong,ByValdwVolumeAsLong)AsLong
DeclareFunctionauxGetVolumeLib"winmm.dll"(ByValuDeviceIDAsLong,ByReflpdwVolumeAsLong)AsLong
DeclareFunctionauxOutMessageLib"winmm.dll"(ByValuDeviceIDAsLong,ByValmsgAsLong,ByValdw1AsLong,ByValdw2AsLong)AsLong

'****************************************************************************
'*PossibleReturnvaluesfromauxGetVolume,auxSetVolume*
'****************************************************************************
PublicConstMMSYSERR_NOERROR=0
PublicConstMMSYSERR_BASE=0
PublicConstMMSYSERR_BADDEVICEID=(MMSYSERR_BASE 2)

'****************************************************************************
'*UsetheCopyMemoryfunctionfromtheWindowsAPI*
'****************************************************************************
PublicDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(hpvDestAsAny,hpvSourceAsAny,ByValcbCopyAsLong)

'****************************************************************************
'*UsethisstructuretobreaktheLongintotwoIntegers*
'****************************************************************************
PublicTypeVolumeSetting
LeftVolAsInteger
RightVolAsInteger
EndType

SublCrossFader()
'Vol1=100-Slider1.Value'Left
'Vol2=100-Slider5.Value'Right
'E=CrossFader.Value
'F=100-E
'IfCheck4.Value=1Then'HalfFaderCheck
'LVol=(F*Val(Vol1)/100)*2
'RVol=(E*Val(Vol2)/100)*2
'IfLVol>(50*Val(Vol1)/100)*2Then
'LVol=(50*Val(Vol1)/100)*2
'EndIf
'IfRVol>(50*Val(Vol2)/100)*2Then
'RVol=(50*Val(Vol2)/100)*2
'EndIf
'Else
'LVol=(F*Val(Vol1)/100)
'RVol=(E*Val(Vol2)/100)
'EndIf
'Label1.Caption="Fader:" LTrim$(Str$(LVol)) "x" LTrim$(Str$(RVol))
'
EndSub

PublicFunctionlSetVolume(ByReflLeftVolAsLong,ByReflRightVolAsLong,lDeviceIDAsLong)AsLong
'****************************************************************************
'*ThisfunctionsetsthecurrentWindowsvolumesettingstothespecified*
'*deviceusingtwoCustomnumbersfrom0toHIGHEST_VOLUME_SETTINGforthe*
'*rightandleftvolumesettings.*
'**
'*ThereturnvalueofthisfunctionistheReturnvalueoftheauxGetVolume*
'*WindowsAPIcall.*
'****************************************************************************

DimbReturnValueAsBoolean'ReturnValuefromFunction
DimVolumeAsVolumeSetting'Typestructureusedtoconvertalongto/from
'twoIntegers.

DimlAPIReturnValAsLong'ReturnvaluefromAPICall
DimlBothVolumesAsLong'TheAPIpassedvalueoftheCombinedVolumes

'****************************************************************************
'*CalculatetheIntegers*
'****************************************************************************
Volume.LeftVol=nSigned(lLeftVol*65535/HIGHEST_VOLUME_SETTING)
Volume.RightVol=nSigned(lRightVol*65535/HIGHEST_VOLUME_SETTING)

'****************************************************************************
'*CombinetheIntegersintoaLongtobePassedtotheAPI*
'****************************************************************************
lDataLen=Len(Volume)
CopyMemorylBothVolumes,Volume.LeftVol,lDataLen

'****************************************************************************
'*SettheValuetotheAPI*
'****************************************************************************
lAPIReturnVal=auxSetVolume(lDeviceID,lBothVolumes)
lSetVolume=lAPIReturnVal

EndFunction

PublicFunctionlGetVolume(ByReflLeftVolAsLong,ByReflRightVolAsLong,lDeviceIDAsLong)AsLong
'****************************************************************************
'*ThisfunctionreadsthecurrentWindowsvolumesettingsfromthe*
'*specifieddevice,andreturnstwonumbersfrom0to*
'*HIGHEST_VOLUME_SETTINGfortherightandleftvolumesettings.*
'**
'*ThereturnvalueofthisfunctionistheReturnvalueoftheauxGetVolume*
'*WindowsAPIcall.*
'****************************************************************************

DimbReturnValueAsBoolean'ReturnValuefromFunction
DimVolumeAsVolumeSetting'Typestructureusedtoconvertalongto/from
'twoIntegers.
DimlAPIReturnValAsLong'ReturnvaluefromAPICall
DimlBothVolumesAsLong'TheAPIReturnoftheCombinedVolumes

'****************************************************************************
'*GettheValuefromtheAPI*
'****************************************************************************
lAPIReturnVal=auxGetVolume(lDeviceID,lBothVolumes)

'****************************************************************************
'*SplittheLongvaluereturnedfromtheAPIintotoIntegers*
'****************************************************************************
lDataLen=Len(Volume)
CopyMemoryVolume.LeftVol,lBothVolumes,lDataLen

'****************************************************************************
'*CalculatetheReturnValues.*
'****************************************************************************
lLeftVol=HIGHEST_VOLUME_SETTING*lUnsigned(Volume.LeftVol)/65535
lRightVol=HIGHEST_VOLUME_SETTING*lUnsigned(Volume.RightVol)/65535

lGetVolume=lAPIReturnVal
EndFunction

PublicFunctionnSigned(ByVallUnsignedIntAsLong)AsInteger
DimnReturnValAsInteger'ReturnvaluefromFunction

IflUnsignedInt>65535OrlUnsignedInt<0Then
MsgBox"ErrorinconversionfromUnsignedtonSignedInteger"
nSignedInt=0
ExitFunction
EndIf

IflUnsignedInt>32767Then
nReturnVal=lUnsignedInt-65536
Else
nReturnVal=lUnsignedInt
EndIf

nSigned=nReturnVal

EndFunction

PublicFunctionlUnsigned(ByValnSignedIntAsInteger)AsLong
DimlReturnValAsLong'ReturnvaluefromFunction

IfnSignedInt<0Then
lReturnVal=nSignedInt 65536
Else
lReturnVal=nSignedInt
EndIf

IflReturnVal>65535OrlReturnVal<0Then
MsgBox"ErrorinconversionfromnSignedtoUnsignedInteger"
lReturnVal=0
EndIf

lUnsigned=lReturnVal
EndFunction->