求vb全局静音
就是调用过程后整个电脑没有声音，不是控制系统音量，关闭程序后声音又恢复
可以找找API，可能有些Messge可以实现，但是目前我没找到，如果认真回复非常感谢
[解决办法]
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const BM_GETCHECK = &HF0 ' 取得复选框状态
Private Const BM_SETCHECK = &HF1 '设置复选框状态
' Private Const BST_UNCHECKED = &00 设置复选框为未选中状态
' Private Const BST_CHECKED = &01 设置复选框为选中状态
Private Sub Command1_Click()
Dim hwnd0 As Long ' 用于记录“音量控制”程序的句柄
Shell "sndvol32.exe" ' 启动“音量控制”程序
hwnd0 = FindWindow(vbNullString, "主音量")
Dim hwnd1 As Long ' 用于记录“全部静音”复选框句柄
hwnd1 = FindWindowEx(hwnd0, 0&, "Button", "全部静音(&M)") ' 复选框的类名是"Button"
Dim State As Long ' 用于记录复选框状态，如果复选框处于未选中状态，则返回0，选中状态返回1
State = SendMessage(hwnd1, BM_GETCHECK, ByVal CLng(0), ByVal CLng(0))
SendMessage hwnd1, BM_SETCHECK, 1, 0 '使系统静音
SendMessage hwnd1, BM_SETCHECK, 0, 0 '使系统发音
End Sub
[解决办法]
http://hi.baidu.com/zgmg/blog/item/eafece50b0832b511138c255.html
[解决办法]
'Example Name:auxVolumePrivate Const HIGHEST_VOLUME_SETTING = 100 '%Private Const AUX_MAPPER = -1&Private Const MAXPNAMELEN = 32Private Const AUXCAPS_CDAUDIO = 1 ' audio from internal CD-ROM drivePrivate Const AUXCAPS_AUXIN = 2 ' audio from auxiliary input jacksPrivate Const AUXCAPS_VOLUME = &H1 ' supports volume controlPrivate Const AUXCAPS_LRVOLUME = &H2 ' separate left-right volume controlPrivate Const MMSYSERR_NOERROR = 0Private Const MMSYSERR_BASE = 0Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)Private Type AUXCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * MAXPNAMELEN wTechnology As Integer dwSupport As LongEnd TypePrivate Type VolumeSetting LeftVol As Integer RightVol As IntegerEnd TypePrivate Declare Function auxGetNumDevs Lib "winmm.dll" () As LongPrivate Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As LongPrivate Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As LongPrivate Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByRef lpdwVolume As VolumeSetting) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Private 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 = nReturnValEnd FunctionPrivate 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 = lReturnValEnd FunctionPrivate Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long Dim Volume As VolumeSetting, lBothVolumes As Long Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING) Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING) 'copy our Volume-variable to a long CopyMemory lBothVolumes, Volume.LeftVol, Len(Volume) 'call the SetVolume-function lSetVolume = auxSetVolume(lDeviceID, lBothVolumes)End FunctionPrivate Sub Form_Load() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim Volume As VolumeSetting, Cnt As Long, AC As AUXCAPS 'set the output to a persistent graphic Me.AutoRedraw = True 'loop through all the devices For Cnt = 0 To auxGetNumDevs - 1 'auxGetNumDevs is zero-based 'get the volume auxGetVolume Cnt, Volume 'get the device capabilities auxGetDevCaps Cnt, AC, Len(AC) 'print the name on the form Me.Print "Device #" + Str$(Cnt + 1) + ": " + Left(AC.szPname, InStr(AC.szPname, vbNullChar) - 1) 'print the left- and right volume on the form Me.Print "Left volume:" + Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535) Me.Print "Right volume:" + Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535) 'set the left- and right-volume to 50% lSetVolume 50, 50, Cnt Me.Print "Both volumes now set to 50%" 'empty line Me.Print NextEnd Sub
[解决办法]
调节系统音量的类(VB原创)：
http://xsoft.bokee.com/4780183.html
这个可以做成ActiveX DLL
[解决办法]
调用方法：
Option Explicit Dim IsMute As BooleanPrivate Sub Command1_Click() Dim VO As Class1 Set VO = New Class1 Call VO.GetMute(IsMute) If IsMute Then VO.SetMute (False) Debug.Print "yes" Else VO.SetMute (True) Debug.Print "NO" End If Set VO = NothingEnd Sub
[解决办法]
下面这个是发消息实现的，很简单：
（这个是马云剑的：http://topic.csdn.net/u/20080214/18/3b685669-2e33-4bd4-8274-d4778bb9ff27.html）
'新建EXE工程,添加三个按钮.'按钮一是音量增加,按钮二是音量减少,按钮三是静音切换.Option ExplicitPrivate Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As LongPrivate Const WM_APPCOMMAND As Long = &H319Private Const APPCOMMAND_VOLUME_UP As Long = 10Private Const APPCOMMAND_VOLUME_DOWN As Long = 9Private Const APPCOMMAND_VOLUME_MUTE As Long = 8Private Sub Command1_Click() '音量增加 SendMessage Me.hwnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_UP * &H10000End SubPrivate Sub Command2_Click() '音量减少 SendMessage Me.hwnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_DOWN * &H10000End SubPrivate Sub Command3_Click() '静音 SendMessage Me.hwnd, WM_APPCOMMAND, &H200EB0, APPCOMMAND_VOLUME_MUTE * &H10000End Sub
