好吧，有好多软件可以实现；
好久前了，忘得
Naudio 使用
下载NAUDIO
Imports NAudio.Wave
录音
1.设置绘冲区大小
BufferMilliseconds 设置缓冲区大小
缓冲区太小，绘冲区太大，导致 声音断开或是重复过快
wav.BufferMilliseconds = 200 '缓冲区大小= ; 200 = 6400；100 = 3200
wav.NumberOfBuffers = 12 '缓冲区数量
wav.WaveFormat = New WaveFormat(16000, 16, 1) '格式 16000
2设置录音回调函数
AddHandler wav.DataAvailable, AddressOf waveIn_DataAvailable
wav.StartRecording() '录音启动
3添加回调函数
Private Sub waveIn_DataAvailable(sender As Object, e As WaveInEventArgs)
End Sub
函数
开始录音
wav.StartRecording() '录音启动
关闭录音
wav.StopRecording()
获取录音数据（回调函数中使用
（global）
' 10分钟录音数据
Dim WavMaxLen As Integer = 16000 * 60 * 10
Dim WavData16(WavMaxLen) As Int16
回调函数中 e.BytesRecorded
Dim b = Pos
Buffer.BlockCopy(e.Buffer, 0, WavData16, b, e.BytesRecorded) '偏移量为字节
' e.Buffer.CopyTo(WavBuffer, Pos)
Dim b = Pos
Buffer.BlockCopy(e.Buffer, 0, WavData16, b, e.BytesRecorded) '偏移量为字节
Pos = Pos + e.BytesRecorded
' Debug.Print("*********pos:" & Pos)
If Pos > 6400 Then
'绘画
Dim tmp = (Pos / 2) - 6400
' Debug.Print("*********tmp:" & tmp)
WavDraw.DrawRecordWav(Pens.Red, WavData16, tmp, 6400)
'For i = 0 To 10
' Debug.Print(WavData16(tmp + i))
'Next
End If
If Pos > WavMaxLen Then
wav.StopRecording()
MsgBox("10min is over")
End If
'e.Buffer, e.BytesRecorded
'不同比例尺绘图
'将数据绘制到窗口中
Imports System.IO
Public Class DrawApi
Const Wav16Height As Integer = 255 * 255
' Public IdataSize As Size '数据尺寸
Public IPictureControl As PictureBox
Public Ibmp As Bitmap
Private nWidth As Double
Private nHeight As Double
Private Igrap As Graphics
Dim Yscale As Integer = 1 '缩放大小
Dim xpos As Integer = 0 '位置
Dim IFudu As Integer = 1 '幅值大小
Dim IWindowLen As Integer = 0
Dim IPenColor As Pen
Dim Idata16 As Int16()
Dim IsDrawData As Boolean = False
''' <param name="PictureControl"></param> 绘制的图像框
Public Sub New(PictureControl As PictureBox, Optional windowslen As Integer = 6400)
IWindowLen = windowslen
IPictureControl = PictureControl
Ibmp = New Bitmap(PictureControl.Width, PictureControl.Height, Imaging.PixelFormat.Format24bppRgb)
Igrap = Graphics.FromImage(Ibmp)
'Igrap.Clear(Color.White)
End Sub
Public Sub SetWindowLen(Wlen As Integer)
IWindowLen = Wlen
End Sub
'绘线
Public Sub DrawLine(Pcolor As Pen, P1 As Point, P2 As Point)
Dim NewP1 As Point
Dim NewP2 As Point
Dim NewWidth, NewHeigh As Double
NewWidth = nWidth * Yscale
NewHeigh = nHeight * Yscale * IFudu
NewP1 = New Point(P1.X * NewWidth, P1.Y * NewHeigh + IPictureControl.Height / 2)
NewP2 = New Point(P2.X * NewWidth, P2.Y * NewHeigh + IPictureControl.Height / 2)
Igrap.DrawLine(Pcolor, NewP1, NewP2)
If (Not IsDrawData) Then
IPictureControl.Image = Ibmp
End If
End Sub
'绘制文件
Public Function DrawWaveFile(filename As String) As Int16()
Dim fs As FileStream
fs = New FileStream(filename, FileMode.Open)
ReDim Idata16(fs.Length / 2)
Dim buff(fs.Length) As Byte
fs.Read(buff, 44, fs.Length - 44)
Buffer.BlockCopy(buff, 0, Idata16, 0, fs.Length)
DrawRecordWav(Pens.Blue, Idata16, 0, IWindowLen)
fs.Close()
Return Idata16
End Function
'绘制录音数据
Public Function DrawRecordWav(PenColor As Pen, data16() As Int16, start As Integer, len As Integer)
nWidth = IPictureControl.Width / IWindowLen
nHeight = IPictureControl.Height / (255 * 10)
Igrap.Clear(IPictureControl.BackColor)
Idata16 = data16
IPenColor = PenColor
IsDrawData = True
Dim SPoint, Epoint As Point
For i = 0 To IWindowLen
Epoint.X = i
Epoint.Y = data16(start + i)
DrawLine(PenColor, SPoint, Epoint)
SPoint.X = (i + 1)
SPoint.Y = 0
Next
IPictureControl.Image = Ibmp
IsDrawData = False
End Function
'绘制WAV数据
'Public Function DrawWavData16(PenColor As Pen, data16() As Int16)
' nWidth = IPictureControl.Width / IWindowLen
' nHeight = IPictureControl.Height / Wav16Height
' Igrap.Clear(IPictureControl.BackColor)
' Idata16 = data16
' IPenColor = PenColor
' IsDrawData = True
' Dim SPoint, Epoint As Point
' For i = 0 To (data16.Count - 1) / Yscale
' If (i + xpos) > data16.Length - 2 Then
' Exit For
' End If
' Epoint.X = i
' Epoint.Y = data16(i + xpos)
' DrawLine(PenColor, SPoint, Epoint)
' SPoint.X = (i + 1)
' SPoint.Y = 0
' Next
' IPictureControl.Image = Ibmp
' IsDrawData = False
'End Function
'放大 缩小
Public Sub Scale(num As Integer)
Yscale = num
DrawRecordWav(Pens.Blue, Idata16, xpos, 6400)
End Sub
'位置
Public Sub Pos(num As Integer)
xpos = num
DrawRecordWav(Pens.Blue, Idata16, xpos, 6400)
End Sub
'幅值
Public Sub Fudu(num As Integer)
IFudu = num
DrawRecordWav(Pens.Blue, Idata16, xpos, 6400)
End Sub
'绘制文本
Public Sub DrawText(x As Integer, y As Integer, fontsize As Integer, Text As String)
Dim drawFont As New Font("Arial", fontsize)
Dim drawBrush As New SolidBrush(Color.Black)
Dim drawPoint As New PointF(Xtox(x), y)
Igrap.DrawString(Text, drawFont, drawBrush, drawPoint)
End Sub
Private Function Xtox(x As Double) As Double
Return x * nWidth * Yscale
End Function
Private Function YtoY(y As Double) As Double
Return y * IPictureControl.Height / Wav16Height * Yscale
End Function
Public Sub DrawRect(pen As Pen, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer)
Dim x1pos, y1pos, x2pos, y2pos, wpos, hpos As Integer
x1pos = Xtox(x1)
y1pos = YtoY(y1) * IFudu + IPictureControl.Height / 2
x2pos = Xtox(x2)
y2pos = YtoY(y2) * IFudu + IPictureControl.Height / 2
wpos = x2pos - x1pos
hpos = y2pos - y1pos
Igrap.DrawRectangle(pen, x1pos, y1pos, wpos, hpos)
'IPictureControl.Image = Ibmp
End Sub
Public Sub DrawPixel(pen As Pen, x As Integer, y As Integer)
Igrap.DrawEllipse(pen, Convert.ToInt32(Xtox(x)), Convert.ToInt32(YtoY(y)), 5, 5)
End Sub
Public Sub Show()
IPictureControl.Image = Ibmp
End Sub
End Class
'------------------------------------naudio 录音--------------------------------------------------------
Dim wav As New WaveIn
Private Sub RecordWavCBox_CheckedChanged(sender As Object, e As EventArgs) Handles RecordWavCBox.CheckedChanged
If RecordWavCBox.Checked Then
Pos = 0
wav.BufferMilliseconds = 200 '缓冲区大小= ; 200 = 6400；100 = 3200
wav.NumberOfBuffers = 12 '缓冲区数量
wav.WaveFormat = New WaveFormat(16000, 16, 1) '格式 16000
AddHandler wav.DataAvailable, AddressOf waveIn_DataAvailable
wav.StartRecording() '录音启动
RecordWavCBox.Text = "停止"
Else
'录音数据备份
ReDim WavDataCopy(WavMaxLen)
WavData16.CopyTo(WavDataCopy, 0)
WavLen = Pos
'停止录音
wav.StopRecording()
RecordWavCBox.Text = "录音"
End If
End Sub
'--------------------------------录音回调函数--------------------------------------------------
' 10分钟录音数据
Dim WavMaxLen As Integer = 16000 * 60 * 10
Dim WavData16(WavMaxLen) As Int16
Dim WavLen As Integer = 0 '录音数据长度 byte
Dim Pos As Integer = 0
Private Sub waveIn_DataAvailable(sender As Object, e As WaveInEventArgs)
' e.Buffer.CopyTo(WavBuffer, Pos)
Dim b = Pos
Buffer.BlockCopy(e.Buffer, 0, WavData16, b, e.BytesRecorded) '偏移量为字节
Pos = Pos + e.BytesRecorded
Debug.Print("*********pos:" & Pos)
If Pos > 6400 Then
'绘画
Dim tmp = (Pos / 2) - 6400
Debug.Print("*********tmp:" & tmp)
WavDraw.DrawRecordWav(Pens.Red, WavData16, tmp, 6400)
For i = 0 To 10
Debug.Print(WavData16(tmp + i))
Next
End If
XPosScrol.Maximum = Pos / 2
XPosScrol.Value = Pos / 2
Debug.WriteLine("***************")
If Pos > WavMaxLen Then
wav.StopRecording()
MsgBox("10min is over")
End If
'e.Buffer, e.BytesRecorded
End Sub
'-------------------------全部数据保存-----------------------------------------------
Private Sub AllWavSavBtn_Click(sender As Object, e As EventArgs) Handles AllWavSavBtn.Click
Dim FileNameStr As String = T1head.Text & T2num.Text & T3Num.Text
WaveSave.WaveSaveFile("E:\" & FileNameStr & ".wav")
Dim tmp(WavLen) As Byte
Buffer.BlockCopy(WavData16, 0, tmp, 0, WavLen)
WaveSave.WaveWriteFile(tmp, WavLen)
WaveSave.CloseWaveFile()
ListBox1.Items.Add("f:\" & FileNameStr & ".wav")
End Sub
'----------------------------------------保--存-------------------------------------------------
Private Sub WavSaveBtn_Click(sender As Object, e As EventArgs) Handles SaveRecordBtn.Click
Dim FileNameStr As String = T1head.Text & T2num.Text & T3Num.Text
WaveSave.WaveSaveFile("f:\" & FileNameStr & ".wav")
Dim StartPos As Integer = 0
Dim Length As Integer = 0
StartPos = XPosScrol.Value
'Length = WavData16.Length / YScaleScrol.Value
Length = windowLen.Text
Dim tmp(Length * 2) As Byte
Buffer.BlockCopy(WavData16, StartPos * 2, tmp, 0, Length * 2)
WaveSave.WaveWriteFile(tmp, Length * 2)
WaveSave.CloseWaveFile()
ListBox1.Items.Add("f:\" & FileNameStr & ".wav")
End Sub
'-----------------------------原始数据片断保存------------------------------
Private Sub RawWavDataSavBtn_Click(sender As Object, e As EventArgs) Handles RawWavDataSavBtn.Click
Dim FileNameStr As String = T1head.Text & T2num.Text & "-" & T3Num.Text
WaveSave.WaveSaveFile("f:\" & FileNameStr & ".wav")
Dim StartPos As Integer = 0
Dim Length As Integer = 0
StartPos = XPosScrol.Value
Length = windowLen.Text
Dim tmp(Length * 2) As Byte
Buffer.BlockCopy(WavDataCopy, StartPos * 2, tmp, 0, Length * 2)
WaveSave.WaveWriteFile(tmp, Length * 2)
WaveSave.CloseWaveFile()
ListBox1.Items.Add("f:\" & FileNameStr & ".wav")
T2num.Text = T2num.Text + 1
End Sub