vb.net設置音量

調用系統(tǒng)Api

網站建設哪家好，找創(chuàng)新互聯(lián)！專注于網頁設計、網站建設、微信開發(fā)、微信小程序定制開發(fā)、集團企業(yè)網站建設等服務項目。為回饋新老客戶創(chuàng)新互聯(lián)還提供了郊區(qū)免費建站歡迎大家使用！

[DllImport("winmm.dll")] //引用winmm.dll

public static extern long waveOutSetVolume(long deviceID, long Volume);

在winmm.dll中

第一個參數可以為0，表示首選設備

第二個參數為音量:0xFFFF為最大，0x0000為最小，其中高位（前兩位）表示右聲道音量，低位（后兩位）表示左 聲道音量 。

2、彈出系統(tǒng)音量調節(jié)框

ProcessStartInfo Info=new ProcessStartInfo();

Info.FileName = "Sndvol32";

Process.Start(Info);

vb.net聲道控制

左右聲道控制的原理：

waveOutGetVolume取得的音量值轉換成16進制，高位是左聲道的值，低位是右聲道的值。

’這段代碼摘這段代碼摘自互聯(lián)網

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來進行細致的控制。

下載類庫，可以實現(xiàn)左右聲道的控制

vb.net中如何播放聲音，是要什么控件嘛？

My.Computer.Audio.Play("SoundFile.wav")

SoundFile.wav是你要播放的聲音文件的路徑

VB.NET問題，做一個定時響鈴提醒程序，怎樣在程序中引用鈴音，請寫寫代碼，是在timer中添加代碼嗎

把類似下面的三行代碼放入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 '格式標志，區(qū)分不同的格式，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 '每秒的字節(jié)數，即數據率。

'數據率 = 通道數×采樣率×采樣大小 / 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 　 過渡字節(jié)（不定）

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。播放軟件利用此值可以估計緩沖區(qū)的大小。

intBlock As Integer ' 20H 2 int 數據塊的調整數（按字節(jié)算的），其值為通道數×每樣本的數據位值／8。播放軟件需要一次處理多個該值大小的字節(jié)數據，以便將其值用于緩沖區(qū)的調整。

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 '這里應該對兩個頭作比較，如果采樣率，聲道數等等不一致的話不能進行連接

'偶就偷懶不做這個校驗啦，如果要實際應用千萬要完成這一塊的代碼

'創(chuàng)建新頭

headNew = headFirst '先拷貝一個頭過來

headNew.lngFileLen = headFirst.lngDataLenth + headNext.lngDataLenth + 37

'文件長度等于兩個文件的數據長度相加再加上頭的長度，為什么是37呢？我也不明白！頭的總長度是44，去掉4個字節(jié)的riff標志和4個字節(jié)的文件長度也應該是36哇?？墒悄愦蜷_一個wav文件把文件長度字段減去數據長度字段，就是活見鬼的37。我想了好久總想不通最后妥協(xié)直接寫了個37在這里！:(

headNew.lngDataLenth = headFirst.lngDataLenth + headNext.lngDataLenth

'數據段的長度就是兩個文件的數據相加啦

'下面是文件操作，為了加快編碼速度減少腦細胞損傷，下面的代碼效率很低，大家自己優(yōu)化啦，如果直接用下面的代碼勸大家不要讀太大的文件，很夠嗆哦~~

'把兩個文件的數據讀出來??！

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