程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> Visual Basic語言 >> VB綜合教程 >> 如何控制系統音量

如何控制系統音量

編輯:VB綜合教程
->'thankstoRickRatayczakofFutureWorksMedia([email protected])
  '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->->

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved