调用系统Api
网站建设哪家好，找创新互联！专注于网页设计、网站建设、微信开发、微信小程序定制开发、集团企业网站建设等服务项目。为回馈新老客户创新互联还提供了郊区免费建站欢迎大家使用！
[DllImport("winmm.dll")] //引用winmm.dll
public static extern long waveOutSetVolume(long deviceID, long Volume);
在winmm.dll中
第一个参数可以为0，表示首选设备
第二个参数为音量:0xFFFF为最大，0x0000为最小，其中高位（前两位）表示右声道音量，低位（后两位）表示左 声道音量 。
2、弹出系统音量调节框
ProcessStartInfo Info=new ProcessStartInfo();
Info.FileName = "Sndvol32";
Process.Start(Info);
左右声道控制的原理：
waveOutGetVolume取得的音量值转换成16进制，高位是左声道的值，低位是右声道的值。
’这段代码摘这段代码摘自互联网
Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Const WAVE_MAPPER = -1
Public Function SetLR(ByVal L As Long, ByVal R As Long) As Long
Dim mLR As String
mLR = "H" Right("0000" Hex(L), 4) Right("0000" Hex(R), 4)
waveOutSetVolume WAVE_MAPPER, CLng(mLR)
End Function
Public Function GetLR(ByRef L As Long, ByRef R As Long) As Long
Dim LR As Long
waveOutGetVolume WAVE_MAPPER, LR
L = CLng("H" Left(Hex(LR), 4))
R = CLng("H" Right(Hex(LR), 4))
End Function
以上2个自定义的函数可以方便的取得和设置左右声道。
如：
Private Sub Form_Load()
Dim mL As Long, mR As Long
GetLR mL, mR
MsgBox "左" mL "--右" mR
End Sub
Private Sub Command1_Click()
SetLR 65535, 22222
End Sub
可以用一个Slider来进行细致的控制。
下载类库，可以实现左右声道的控制
My.Computer.Audio.Play("SoundFile.wav")
SoundFile.wav是你要播放的声音文件的路径
把类似下面的三行代码放入timer即可。关键是放音程序。
DealWav.mciSendString "open " sA " alias wav", sB, Len(sB), 0
DealWav.mciSendString "play wav ", sB, Len(sB), 0
DealWav.mciSendString "close wav ", sB, Len(sB), 0
送你DealWav模块
Dim WAVBuffer() As Byte
Dim DataLenOut As Long
Dim Datapos1 As Long
Dim Datapos2 As Long
Dim ChunkLen As Long
Dim factpos As Long
Type PCMWAVEFORMAT '标准 PCM 格式定义
wFormatTag As Integer '格式标志，区分不同的格式，PCM 为 1
nChannels As Integer '音频通道数，单声道为 1 ，立体声为 2
nSamplesPerSec As Long '每秒的采样数，即采样率。
'标准的采样率有8.000 kHz 、11.025 kHz 、
'22.050 kHz 、44.100 kHz 等。
nAvgBytesPerSec As Long '每秒的字节数，即数据率。
'数据率 = 通道数×采样率×采样大小 / 8
nBlockAlign As Integer '块对齐，即波形数据的最小单位。
'块对齐 = 通道数×采样大小 / 8
wBitsPerSample As Integer '每个采样所占的位数，即采样大小。
'采样大小有 8 位和 16 位两种。
End Type
Private Type WaveHead
strRiff As String * 4 ' 00H 4 char "RIFF"标志
lngFileLen As Long ' 04H 4 long int 文件长度
strWave As String * 4 ' 08H 4 char "WAVE"标志
strFmt As String * 4 ' 0CH 4 char "fmt"标志
lngTmp As Long ' 10H 4 过渡字节（不定）
intFormat As Integer ' 14H 2 int 格式类别（10H为PCM形式的声音数据)
intChan As Integer ' 16H 2 int 通道数，单声道为1，双声道为2
intFreq As Long ' 18H 2 int 采样率（每秒样本数），表示每个通道的播放速度，
lngSendSpeed As Long ' 1CH 4 long int 波形音频数据传送速率，其值为通道数×每秒数据位数×每样本的数据位数／8。播放软件利用此值可以估计缓冲区的大小。
intBlock As Integer ' 20H 2 int 数据块的调整数（按字节算的），其值为通道数×每样本的数据位值／8。播放软件需要一次处理多个该值大小的字节数据，以便将其值用于缓冲区的调整。
intBit As Integer ' 22H 2 每样本的数据位数，表示每个声道中各个样本的数据位数。如果有多个声道，对每个声道而言，样本大小都一样。
strData As String * 4 ' 24H 4 char 数据标记符＂data＂
lngDataLenth As Long ' 28H 4 long int 语音数据的长度
End Type
Public Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
' flag uitzetten
Public Const SND_SYNC = H0
Public Const SND_ASYNC = H1
Public Const SND_NODEFAULT = H2
Public Const SND_MEMORY = H4
Public Const SND_LOOP = H8
Public Const SND_NOSTOP = H10
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Sub Command1_Click()
'为了防止随意选取的两个wav文件格式不同，我干脆就将同一个文件重复两次
LinkWav "C:\WINNT\Media\ringout.wav", "C:\WINNT\Media\ringout.wav", "f:\temp.wav"
End Sub
Private Function getWavHead(strFileName As String) As WaveHead
'获取文件头
Dim iFreeFile
iFreeFile = FreeFile()
On Error GoTo ErrHandle
Dim MyHead As WaveHead
Open strFileName For Binary As #iFreeFile
Get #iFreeFile, , MyHead
Close #iFreeFile
getWavHead = MyHead
ErrHandle:
End Function
Public Function LinkWav(strFileName1 As String, strFileName2 As String, strOutFile As String) As Boolean
Dim headFirst As WaveHead
Dim headNext As WaveHead
Dim headNew As WaveHead '新文件的头
Dim Data1() As Byte
Dim Data2() As Byte
Dim i As Long
LinkWav = False
'获取头
headFirst = getWavHead(strFileName1)
headNext = getWavHead(strFileName2)
'文件头比较
DoEvents '这里应该对两个头作比较，如果采样率，声道数等等不一致的话不能进行连接
'偶就偷懒不做这个校验啦，如果要实际应用千万要完成这一块的代码
'创建新头
headNew = headFirst '先拷贝一个头过来
headNew.lngFileLen = headFirst.lngDataLenth + headNext.lngDataLenth + 37
'文件长度等于两个文件的数据长度相加再加上头的长度，为什么是37呢？我也不明白！头的总长度是44，去掉4个字节的riff标志和4个字节的文件长度也应该是36哇。可是你打开一个wav文件把文件长度字段减去数据长度字段，就是活见鬼的37。我想了好久总想不通最后妥协直接写了个37在这里！:(
headNew.lngDataLenth = headFirst.lngDataLenth + headNext.lngDataLenth
'数据段的长度就是两个文件的数据相加啦
'下面是文件操作，为了加快编码速度减少脑细胞损伤，下面的代码效率很低，大家自己优化啦，如果直接用下面的代码劝大家不要读太大的文件，很够呛哦~~
'把两个文件的数据读出来！！
ReDim Data1(headFirst.lngDataLenth - 1)
'Open strFileName1 For Random As #1 Len = 1
Open strFileName1 For Binary As #1
For i = 0 To headFirst.lngDataLenth - 1
Get #1, 45 + i, Data1(i)
Next
Close #1
ReDim Data2(headNext.lngDataLenth - 1)
'Open strFileName2 For Random As #1 Len = 1
Open strFileName2 For Binary As #1 'Len = 1
For i = 0 To headNext.lngDataLenth - 1
Get #1, 45 + i, Data2(i)
Next
Close #1
'开始写数据啦
'Open strOutFile For Random As #1 Len = 1
Open strOutFile For Binary As #1
Put #1, , headNew ' 将头写入文件中。
'Close #1
'Open strOutFile For Random As #1 Len = 1
For i = 0 To UBound(Data1)
Put #1, 45 + i, Data1(i) ' 将第一个记录写入文件中。
Next
For i = 0 To UBound(Data2)
Put #1, , Data2(i) ' 将第一个记录写入文件中。
Next
Close #1 ' 关闭文件。
End Function
'合并两个WAV声音文件
Public Function WavMerge(Wave1() As Byte, Wave2() As Byte) As Variant
Dim xx As Long
Dim Y$
'1，确定data chunk的起始点(不同的WAV文件可能会不尽相同)
Do While Y$ "data"
Y$ = Chr(Wave1(xx)) Chr(Wave1(xx + 1)) Chr(Wave1(xx + 2)) Chr(Wave1(xx + 3))
xx = xx + 1
If xx 1000 Then
MsgBox "未知格式"
Exit Function
End If
Loop
Datapos1 = (xx - 1) + 8
xx = 0
Y$ = ""
Do While Y$ "data"
Y$ = Chr(Wave2(xx)) Chr(Wave2(xx + 1)) Chr(Wave2(xx + 2)) Chr(Wave2(xx + 3))
xx = xx + 1
If xx 1000 Then
MsgBox "未知格式"
Exit Function
End If
Loop
Datapos2 = (xx - 1) + 8
xx = 0
Y$ = ""
'2,确定第一个参数Wave1声音中是否包含可选的fact chunk
factpos = 0
Do While Y$ "fact"
Y$ = Chr(Wave1(xx)) Chr(Wave1(xx + 1)) Chr(Wave1(xx + 2)) Chr(Wave1(xx + 3))
xx = xx + 1
If xx 1000 Then
xx = 0
Exit Do
End If
Loop
factpos = xx - 1
If factpos = -1 Then factpos = 36
DataLenOut = UBound(Wave1) + 1 - Datapos1 + UBound(Wave2) + 1 - Datapos2
ReDim WAVBuffer(factpos + 19 + DataLenOut)
'3,写入合并后的RIFF('wave'...fmt...[fact]...头信息
RtlMoveMemory WAVBuffer(0), Wave1(0), factpos '注：采样速率，平均数据速率，采样大小，声道以Wave1参数为准
WAVBuffer(factpos) = Asc("f"): WAVBuffer(factpos + 1) = Asc("a")
WAVBuffer(factpos + 2) = Asc("c"): WAVBuffer(factpos + 3) = Asc("t")
ChunkLen = 4
RtlMoveMemory WAVBuffer(factpos + 4), ChunkLen, 4
RtlMoveMemory WAVBuffer(factpos + 8), DataLenOut, 4
WAVBuffer(factpos + 12) = Asc("d"): WAVBuffer(factpos + 13) = Asc("a")
WAVBuffer(factpos + 14) = Asc("t"): WAVBuffer(factpos + 15) = Asc("a")
RtlMoveMemory WAVBuffer(factpos + 16), DataLenOut, 4
'4,写入合并后的data chunk（即所有的samples,先Wave1,后Wave2)
RtlMoveMemory WAVBuffer(factpos + 20), Wave1(Datapos1), UBound(Wave1) - Datapos1 + 1
RtlMoveMemory WAVBuffer(factpos + 20 + UBound(Wave1) - Datapos1 + 1), Wave2(Datapos2), UBound(Wave2) - Datapos2 + 1
'5,更正RIFF头信息
ChunkLen = UBound(WAVBuffer) - 7
RtlMoveMemory WAVBuffer(4), ChunkLen, 4
'6,结束
WavMerge = WAVBuffer
End Function
'合并多个文件
Public Function f_LinkWav(cFile As Collection, sOutFile As String) As Boolean
Dim headFirst As WaveHead
Dim headNext As WaveHead
Dim headNew As WaveHead '新文件的头
Dim byteData() As Byte
Dim iFreeFile As Integer
Dim i As Long
Dim j As Long
Dim iA
Dim lData As Long
f_LinkWav = False
iFreeFile = FreeFile()
'获取头
headFirst = getWavHead(cFile(1))
lData = headFirst.lngDataLenth - 1
ReDim Preserve byteData(lData)
'Open strFileName1 For Random As #1 Len = 1
Open cFile(1) For Binary As #iFreeFile
For i = 0 To lData
Get #iFreeFile, 45 + i, byteData(i)
Next
Close #iFreeFile
headNew = headFirst
headNew.lngFileLen = headFirst.lngDataLenth
headNew.lngDataLenth = headFirst.lngDataLenth
For iA = 2 To cFile.Count
headNext = getWavHead(cFile(iA))
headNew.lngFileLen = headNew.lngFileLen + headNext.lngDataLenth + 37
headNew.lngDataLenth = headNew.lngDataLenth + headNext.lngDataLenth
ReDim Preserve byteData(lData + headNext.lngDataLenth)
Open cFile(iA) For Binary As #iFreeFile 'Len = 1
For i = 1 To headNext.lngDataLenth
Get #iFreeFile, 44 + i, byteData(lData + i)
Next
Close #iFreeFile
lData = lData + headNext.lngDataLenth
Next
'开始写数据啦
'Open strOutFile For Random As #1 Len = 1
If Dir(sOutFile, vbNormal) "" Then Kill sOutFile
Open sOutFile For Random As #iFreeFile
Put #iFreeFile, , headNew ' 将头写入文件中。
Close #iFreeFile
j = UBound(byteData) + 1
'For iA = 2 To giCalltimes
' ReDim Preserve byteData(UBound(byteData) + j)
' For i = 0 To j - 1
' byteData(j + i) = byteData(i) ' 将第一个记录写入文件中。
' Next
'Next iA
Open sOutFile For Random As #iFreeFile Len = 1
For i = 0 To UBound(byteData)
Put #iFreeFile, 45 + i, byteData(i) ' 将第一个记录写入文件中。
Next
' j = UBound(byteData)
'For iA = 2 To giCalltimes
' For i = 0 To UBound(byteData)
' Put #iFreeFile, 45 + i + j + 1, byteData(i) ' 将第一个记录写入文件中。
' Next
' j = j + UBound(byteData)
'Next
Close #iFreeFile ' 关闭文件。
f_LinkWav = True
End Function
Public Function f_MciChkEnd()
Dim MCIStatus As String * 255
Dim lA
f_MciChkEnd = False
lA = mciSendString("status wav mode", MCIStatus, Len(MCIStatus), 0)
If UCase(Left$(MCIStatus, 7)) = "STOPPED" Or Left$(MCIStatus, 2) = "结束" Then f_MciChkEnd = True
End Function
Public Function SendComReturnString(com As String) As String
Dim FeedBack As Long, ReturnString As String * 255
ReturnString = String(255, Chr(0))
FeedBack = mciSendString(com, ReturnString, 255, 0)
If FeedBack Then
Dim s As String * 255
'mciGetErrorString FeedBack, s, 255
SendComReturnString = vbNullString
Else
SendComReturnString = Left(ReturnString, InStr(1, ReturnString, Chr(0)) - 1)
End If
End Function
