vb调节音量代码_vb 麦克风音量 winmm.dll_xiaohe669的博客-程序员秘密

技术标签: VB  

Option Explicit

Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long
Private 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
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Private Const MAXPNAMElen = 32 ' max product name length (including NULL)
Private Const MMSYSERR_NOERROR = 0 ' no error
Private Const GMEM_ZEROINIT = &H40
Private Const CALLBACK_WINDOW = &H10000 ' dwCallback is a HWND
Private Const MIXER_OBJECTF_MIXER = &H0&
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_SOURCE = &H1&
Private Const MIXER_OBJECTF_HANDLE = &H80000000
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Private Const MIXER_OBJECTF_HMIXER = (MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER)
Private Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Private Const MIXERCONTROL_CONTROLTYPE_BOOLEAN = (MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or MIXERCONTROL_CT_UNITS_BOOLEAN)
Private Const MIXERCONTROL_CONTROLTYPE_MUTE = (MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)

Private Type MIXERCONTROLDETAILS_SIGNED
lValue As Long
End Type
Private Type MIXERCONTROLDETAILS_BOOLEAN
fValue As Long
End Type
'''''''''''''''''''''''''''''''''''''''''''''''
'自己定义的类型
Private Type MIXERCONTROLDETAILS_SIGNED_ARRAY_2
v1 As MIXERCONTROLDETAILS_SIGNED
v2 As MIXERCONTROLDETAILS_SIGNED
End Type
'''''''''''''''''''''''''''''''''''''''''''''''
Private Type MIXERCONTROLDETAILS
cbStruct As Long ' size in Byte of MIXERCONTROLDETAILS
dwControlID As Long ' control id to get/set details on
cChannels As Long ' number of channels in paDetails array
item As Long ' hwndOwner or cMultipleItems
cbDetails As Long ' size of _one_ details_XX struct
paDetails As Long ' pointer to array of details_XX structs
End Type
Private Type MIXERCAPS
wMid As Integer ' manufacturer id
wPid As Integer ' product id
vDriverVersion As Long ' version of the driver
szPname As String * MAXPNAMElen ' product name
fdwSupport As Long ' misc. support bits
cDestinations As Long ' count of destinations
End Type
Private Type Target ' for use in MIXERLINE and others (embedded structure)

dwType As Long ' MIXERLINE_TARGETTYPE_xxxx
dwDeviceID As Long ' target device ID of device type
wMid As Integer ' of target device
wPid As Integer ' "
vDriverVersion As Long ' "
szPname As String * MAXPNAMElen
End Type
Private Type MIXERCONTROL
cbStruct As Long ' size in Byte of MIXERCONTROL
dwControlID As Long ' unique control id for mixer device
dwControlType As Long ' MIXERCONTROL_CONTROLTYPE_xxx
fdwControl As Long ' MIXERCONTROL_CONTROLF_xxx
cMultipleItems As Long ' if MIXERCONTROL_CONTROLF_MULTIPLE set
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
Bounds(1 To 6) As Long ' Longest member of the Bounds union
Metrics(1 To 6) As Long ' Longest member of the Metrics union
End Type
Private Type MIXERLINECONTROLS
cbStruct As Long ' size in Byte of MIXERLINECONTROLS
dwLineID As Long ' line id (from MIXERLINE.dwLineID)
' MIXER_GETLINECONTROLSF_ONEBYID or
dwControl As Long ' MIXER_GETLINECONTROLSF_ONEBYTYPE
cControls As Long ' count of controls pmxctrl points to
cbmxctrl As Long ' size in Byte of _one_ MIXERCONTROL
pamxctrl As Long ' pointer to first MIXERCONTROL array
End Type
Private Type MIXERLINE
cbStruct As Long ' size of MIXERLINE structure
dwDestination As Long ' zero based destination index
dwSource As Long ' zero based source index (if source)
dwLineID As Long ' unique line id for mixer device
fdwLine As Long ' state/information about line
dwUser As Long ' driver specific information
dwComponentType As Long ' component type line connects to
cChannels As Long ' number of channels line supports
cConnections As Long ' number of connections (possible)
cControls As Long ' number of controls at this line
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
tTarget As Target
End Type

'最大最小音量
Private m_lMax As Long, m_lMin As Long
'打开的设备句柄
Private m_hMixer As Long
'设备数GetDevNum
Private m_lDeviceNum As Long
'设备ID
Private m_lDeviceID As Long
'设备功能GetDevCaps
Private m_Caps As MIXERCAPS

'打开设备以调节音量
Public Function OpenDeviceForVolume() As Boolean

OpenDeviceForVolume = False

'系统中混频器的总数量
If (mixerGetNumDevs() <> 0) Then
'打开设备
If mixerOpen(m_hMixer, 0, 0, 0, MIXER_OBJECTF_MIXER Or CALLBACK_WINDOW) <> MMSYSERR_NOERROR Then
Exit Function
End If
'获取设备能力
If mixerGetDevCaps(m_hMixer, m_Caps, Len(m_Caps)) <> MMSYSERR_NOERROR Then
Exit Function
End If
End If

'如果打开失败
If m_hMixer = 0 Then Exit Function

Dim mxl As MIXERLINE
Dim mxc As MIXERCONTROL
Dim mxlc As MIXERLINECONTROLS
Dim hMem As Long

hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxc))

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
If mixerGetLineInfo(m_hMixer, mxl, MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE) <> MMSYSERR_NOERROR Then
Exit Function
End If

m_lDeviceNum = mxl.cChannels

mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)
mxlc.pamxctrl = GlobalLock(hMem)

If mixerGetLineControls(m_hMixer, mxlc, MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE) <> MMSYSERR_NOERROR Then
GlobalUnlock hMem
GlobalFree hMem
Exit Function
End If

CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
m_lDeviceID = mxc.dwControlID
m_lMin = mxc.Bounds(1)
m_lMax = mxc.Bounds(2)

GlobalUnlock hMem
GlobalFree hMem
OpenDeviceForVolume = True
End Function

'打开设备以设置静音
Public Function OpenDeviceForMute() As Boolean

OpenDeviceForMute = False

'不懂
If (mixerGetNumDevs() <> 0) Then
'打开设备
If mixerOpen(m_hMixer, 0, 0, 0, MIXER_OBJECTF_MIXER Or CALLBACK_WINDOW) <> MMSYSERR_NOERROR Then
Exit Function
End If
'获取设备能力
If mixerGetDevCaps(m_hMixer, m_Caps, Len(m_Caps)) <> MMSYSERR_NOERROR Then
Exit Function
End If
End If

'如果打开失败
If m_hMixer = 0 Then Exit Function

Dim mxl As MIXERLINE
Dim mxc As MIXERCONTROL
Dim mxlc As MIXERLINECONTROLS
Dim hMem As Long

hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxc))

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
If mixerGetLineInfo(m_hMixer, mxl, MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE) <> MMSYSERR_NOERROR Then
Exit Function
End If

m_lDeviceNum = mxl.cChannels

mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_MUTE
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)
mxlc.pamxctrl = GlobalLock(hMem)

If mixerGetLineControls(m_hMixer, mxlc, MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE) <> MMSYSERR_NOERROR Then
GlobalUnlock hMem
GlobalFree hMem
Exit Function
End If

CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
m_lDeviceID = mxc.dwControlID

GlobalUnlock hMem
GlobalFree hMem
OpenDeviceForMute = True
End Function

'关闭打开的设备
Public Function CloseDevice() As Boolean
CloseDevice = False

If m_hMixer <> 0 Then
mixerClose m_hMixer
m_hMixer = 0
End If

CloseDevice = True
End Function

'设置音量
Public Function SetVolume(ByVal lVol As Long, ByVal rVol As Long) As Boolean
SetVolume = False

'如果设备未打开
If m_hMixer = 0 Then Exit Function

Dim mxcdVolume As MIXERCONTROLDETAILS_SIGNED_ARRAY_2
Dim mxcd As MIXERCONTROLDETAILS
Dim hMem As Long

hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdVolume))

mxcdVolume.v1.lValue = lVol
mxcdVolume.v2.lValue = rVol
mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = m_lDeviceID
mxcd.cChannels = m_lDeviceNum
mxcd.item = 0
mxcd.cbDetails = Len(mxcdVolume.v1)
mxcd.paDetails = GlobalLock(hMem)
CopyPtrFromStruct mxcd.paDetails, mxcdVolume, Len(mxcdVolume)

If mixerSetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
GlobalUnlock (hMem)
GlobalFree (hMem)
Exit Function
End If

GlobalUnlock (hMem)
GlobalFree (hMem)
SetVolume = True
End Function

'获取当前音量
Public Function GetVolume(ByRef lVol As Long, ByRef rVol As Long) As Boolean

GetVolume = False
lVol = -1
rVol = -1

'如果设备未打开
If m_hMixer = 0 Then Exit Function

Dim mxcdVolume As MIXERCONTROLDETAILS_SIGNED_ARRAY_2
Dim mxcd As MIXERCONTROLDETAILS
Dim hMem As Long

hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdVolume))

mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = m_lDeviceID
mxcd.cChannels = m_lDeviceNum
mxcd.item = 0
mxcd.cbDetails = Len(mxcdVolume.v1)
mxcd.paDetails = GlobalLock(hMem)

If mixerGetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
GlobalUnlock (hMem)
GlobalFree (hMem)
Exit Function
End If

CopyStructFromPtr mxcdVolume, mxcd.paDetails, Len(mxcdVolume)

lVol = mxcdVolume.v1.lValue
If m_lDeviceNum = 2 Then
rVol = mxcdVolume.v2.lValue
End If

GlobalUnlock (hMem)
GlobalFree (hMem)
GetVolume = True
End Function

'获取当前是否静音状态
Public Function GetMute(ByRef bMute As Boolean) As Boolean
GetMute = False

If m_hMixer = 0 Then Exit Function

Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN
Dim mxcd As MIXERCONTROLDETAILS
mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = m_lDeviceID
mxcd.cChannels = 1
mxcd.item = 0
mxcd.cbDetails = Len(mxcdMute)
mxcd.paDetails = VarPtr(mxcdMute)
If mixerGetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
Exit Function
End If

If mxcdMute.fValue <> 0 Then
bMute = True
Else
bMute = False
End If

GetMute = True
End Function

'设置静音
'参数为是否静音.
Public Function SetMute(ByVal bMute As Boolean) As Boolean
SetMute = False

If m_hMixer = 0 Then Exit Function

Dim hMem As Long
Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN
Dim mxcd As MIXERCONTROLDETAILS

mxcdMute.fValue = IIf(bMute, 1, 0)
hMem = GlobalAlloc(GMEM_ZEROINIT, Len(mxcdMute.fValue))

mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = m_lDeviceID
mxcd.cChannels = 1
mxcd.item = 0
mxcd.cbDetails = Len(mxcdMute)
mxcd.paDetails = GlobalLock(hMem)

CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)

If mixerSetControlDetails(m_hMixer, mxcd, MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE) <> MMSYSERR_NOERROR Then
GlobalUnlock hMem
GlobalFree hMem
Exit Function
End If

GlobalUnlock hMem
GlobalFree hMem
SetMute = True
End Function

'获取最大音量
Public Function GetMaxVolume() As Long
GetMaxVolume = IIf(m_hMixer = 0, -1, m_lMax)
End Function

'获取最小音量
Public Function GetMinVolume() As Long
GetMinVolume = IIf(m_hMixer = 0, -1, m_lMin)
End Function

Private Sub Class_Initialize()
m_hMixer = 0
m_lMax = -1
m_lMin = -1
End Sub

版权声明:本文为博主原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/xiaohe669/article/details/84933105

智能推荐

js 描述二维数组重新排列组合成一个新的数组_js二维数组时间重新排列怎么做_liuhongyi0104的博客-程序员秘密

这种应用场景会在随机匹配的游戏里 或者 展示所有组合的列表里会用到 假设 有5个人 有5座桥 4个宝箱 有多少种可能的分配? 如何随机分配 ?N=5*5*4 一般直接不太直接看出,但是用局部的,两个组合时有多少种可能,组合后形成一组新的组合,继续与剩下的可能组合,每次组合时只考虑两组,这样就看起来很直接了。T=5*5 N =T*4下面用js代码描述

php之clone 复制对象以及__clone魔术方法_1_bit的博客-程序员秘密

如果错误和不足请给予指出,谢谢~(⊙_⊙)在开始使用clone之前我们下先看以下一个小例子:<?php //首先定义一个test一个类class Testclass { //成员变量是$value1 public $value1;}//随后new一个obj1$obj1 = new Testclass();//复制成员变量的值为qqq$obj1->value1 = "qq

vue 父组件获取接口值传到子组件_Vue中子组件怎么获取父组件的值?(props实现)..._weixin_39990558的博客-程序员秘密

vue中父组件的数据如何传送到子组件中?组件实例的作用域是孤立的。这意味着不能在子组件的模板内直接引用父组件的数据。父组件的数据需要通过 prop 才能下发到子组件中。也就是props是子组件访问父组件数据的唯一接口。所以子组件引用父组件就需要用props实现。也就是props是子组件访问父组件数据的唯一接口。详细一点解释就是:一个组件可以直接在模板里面渲染data里面的数据(双大括号)。子组件不...

软件稳定性测试_麦兜方格的博客-程序员秘密

1 稳定性测试就测试系统的长期稳定运行能力。在系统运行过程中,对系统施压,观察系统的各种性能指标,以及服务器的指标。2 测试场景:模拟平常的压力,模拟实际中日常的用户数进行操作。数据库要存有一定的数据。3 稳定性测试是概率性的测试,就是说即使稳定性测试通过,也不能保证系统实际运行的时候不出问题。所以要尽可能的提高测试的可靠性。可以通过多次测试,延长测试时间,增大测试压力来提高测试的

C++ 递归求数组的平均数_ABC我的博客的博客-程序员秘密

函数返回值类型必须为浮点型。不能为int#include &lt;iostream&gt;using namespace std;float arrayavg(int *A,int n){//返回值类型必须为浮点型。不能为int if(n==0) return A[n]; else return (A[n]+n*arrayavg(A,n-1...

findder 抓包_Fiddler:程序员必备的网络抓包调试工具_Atlas-Geo的博客-程序员秘密

Fiddler是一个非常流行的网络抓包调试工具,也算是比较出名吧。其实说起抓包工具,很多人可能先想到的是wireshark这个经典工具。不过wireshark侧重于网络抓包,可以抓所有类型的数据包,并且解析包的内容。但是Fiddler主要是用来抓取HTTP包的,对HTTP包的内容有多种多样的显示方式。不过考虑到现在大多数时候都用HTTP,所以Fiddler也更加常用一些。捕获网络流量Fiddler...

随便推点

html pc页面自动缩放,PC端禁止页面缩放(原生JavaScript)_青幕的博客-程序员秘密

在PC端缩放浏览器的页面主要有三种方式:Ctrl+(+/-)组合Ctrl+鼠标轮滑浏览器菜单我们是禁止不了用户通过浏览器缩放页面,只能通过对有键盘或鼠标事件的快捷方式做监控,从而实现禁止缩放的快捷方式。禁止Ctrl+(+/-)组合document.addEventListener('keydown',function(event){if((event.ctrlKey===t...

Json字符串处理_jsonobject 字符串包含[]处理_进阶的程序员的博客-程序员秘密

工作中碰到一个Json对象转List不成功的问题,记录下 public static void main(String[] args) { String keywordUpdate = "{\"keywordTypes\":[{\"adgroupId\":10394588,\"keyword\":\"测试1\"},{\"adgroupId\":10394588,\"keyword

git reset hard/soft/mixed区别_reset type一定要改成hard_惹不起的程咬金的博客-程序员秘密

根据–soft –mixed –hard,会对working tree和index和HEAD进行重置:    git reset --mixed:此为默认方式,不带任何参数的git reset,即时这种方式,它回退到某个版本,只保留源码,回退commit和index信息    git reset --soft:回退到某个版本,只回退了commit的信息,不会恢复到index file一级。

bootstrap-Table 插件 java 实现 table 分页及增删改查_bootstrap分页查询_Mors.的博客-程序员秘密

bootstra-table是一个很好用的插件,可以快速实现table的分页及增删改查这是官方文档地址 : http://bootstrap-table.wenzhixin.net.cn/zh-cn/documentation/首先引用所需的插件 &amp;lt;link href=&quot;resource/bootstrap.css&quot; rel=&quot;stylesheet&quot; /&amp;gt;&amp;lt;li...

CentOS 8 安装,Linux系统安装,制作启动分区_centos8分区_Lofit的博客-程序员秘密

关键词:CentOS 8 ,Linux,系统安装,启动分区。背景这是在CentOS 8 刚出来的那段时间做的笔记,因为刚出来,在安装上遇到了一些问题,于是记录下来。要达到的 目的:使用一个硬盘,在真机环境直接安装CentOS8 系统(其他linux类似),无需额外的U盘作为启动盘。准备工作(环境、材料)一台可用的电脑(本次使用win10系统)一个硬盘(用作装系统的硬盘)一个CentOS 8系统的iso文件软件:UltraISO(制作启动)、DiskGenius(硬盘分区)安装过程1

推荐文章

热门文章

相关标签