怎样用VB实现 录制声卡发出的所有声音 (强分)

lisa315 2004-01-13 03:48:42
怎样用VB实现 录制声卡发出的所有声音,并将其保存为一种压缩格式(比如 MP3)
怎样实现呢?
...全文
566 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
华芸智森 2004-01-18
  • 打赏
  • 举报
回复
说错了,是控件.
华芸智森 2004-01-18
  • 打赏
  • 举报
回复
网上关于录音的软件多如牛毛.
http://www.7dstar.com/website/index.html
mingtian2008 2004-01-17
  • 打赏
  • 举报
回复
up
douhapy 2004-01-14
  • 打赏
  • 举报
回复
上面的例子都不错,对于mp3问题,通过工具将Wave文件转换一下就可以了,其实网上可以发现很多mp3控件,有的支持格式转化功能也有的支持录放功能,你可以搜索一下, 应该有你需要的控件
cso 2004-01-13
  • 打赏
  • 举报
回复
转贴:
===================================
VB制作不受限制的录音机
郭东毅
说起录音机程序,大家都会想起Windows自带的那个,但是它有一个非常明显的缺点──有时间限制,录制最长时间不超过60秒,否则就会停下,必须自己按下“录音”键才可以继续录音。
其实,我们可以用VB来自己编一个不受时间限制的录音机,甚至连Windows API都可以不用就能够实现。下面笔者向大家介绍具体的实现方法:
1.首先新建一个标准的EXE工程。我们需要两个Label控件,一个MMContrl控件,一个CommonDialog控件,一个Slider控件。两个Label控件分别用来显示录音的总时间和当前的录音时间。MMContrl控件用来支持录音和播放,CommonDialog控件用来打开和保存声音文件,Slider控件是用来直观地显示录音机的状态。
注:MMContrl控件、CommonDialog控件和Slider控件都不是默认的内部控件,需要添加(在控件工具箱上用右键,选“部件”,在控件列中复选Microsoft Common Dialog Control 6.0(SP3)、Microsoft Multimedia Control 6.0 (SP3)、Microsoft Windows Common Controls 6.0)。
2.主表单命名为frmMain;把Label控件命名为lblNow和lblTotal,Caption命名为“现在时间”和“总共时间”;把MMContrl控件命名为mci,DeviceType设置为WAVEAudio,FileName设置为c:\windows\temp\~temp.wav(在Windows的临时文件夹中生成临时录音文件,该文件实际上并不存在);把CommonDialog控件命名为cdlg,Filter设置为 声音(波形)文件|*.wav;Slider控件命名为sld,Enable设置为False。
3.用菜单编辑器给主表单添加菜单,主菜单项只有一个“文件(mnuFile)”,次级菜单有“新建(mnuFileNew)”、“打开(mnuFileOpen)”、“另存为(mnuFileSaveAs)”,“退出(mnuFileExit)”。
4.一切准备就绪的话,就可以开始了,程序源代码如下:
Option Explicit
Dim blnDirty As Boolean
Dim intResult As Integer
Private Sub Form_Load()
mci.Command = "Open" '打开准备好的文件
mci.TimeFormat = 1 '时间格式设置为秒
blnDirty = False '预先把文件更改设置为否
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If blnDirty = True Then
intResult = MsgBox("需要保存吗?", vbYesNoCancel + vbQuestion, "已经有更改!")
Select Case intResult
Case vbYes
cdlg.CancelError= True ’把取消错误打开
On Error GoTo ccancel ’设置错误拦截
cdlg.ShowSave
mci.FileName=cdlg.FileName
mci.Command="Save"
frmMain.MousePointer=11
mci.Command="close"
blnDirty=False
Case vbNo
mci.Command="close"
blnDirty=False
Case vbCancel
ccancel:
Cancel=1
End Select
frmMain.mousepointer=0
End If
End Sub
Private Sub mci_RecordClick(Cancel As Integer)
blnDirty = True
End Sub
Private Sub mci_StatusUpdate()
lblNow.Caption = "现在时间: " & mci.Position / 1000 & " 秒" '现在时间显示
lblTotal.Caption = "总时间: " & mci.Length / 1000 & " 秒" '总共时间显示
sld.Value = mci.Position / 1000 '滑动条的位置显示
If mci.Mode = mciModeRecord Then
If sld.Value = sld.Max Then '自动加时间
sld.Max=sld.Max + 10
End If
End If
End Sub
Private Sub mci_StopClick(Cancel As Integer)
If mci.Mode = mciModeRecord Then
If sld.Value > 0 Then'期间如果按下了stop键,那么去掉Slider多余的部分
sld.Max = sld.Value
End If
End If
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuFileNew_Click()
If blnDirty = True Then ’如果正在录音的话
intResult = MsgBox("需要保存吗?", vbYesNo + vbQuestion, "已经有了修改!")
Select Case intResult
Case vbYes
cdlg.CancelError = True
On Error GoTo ccancel
cdlg.ShowSave
mci.FileName = cdlg.FileName
mci.Command = "Save"
frmMain.MousePointer = 11
GoTo ExitFileNew
Case vbNo
GoTo ExitFileNew
End Select
ccancel:
Exit Sub
End If
ExitFileNew:
frmMain.MousePointer = 0
mci.Command = "close"
mci.Command = "open"
blnDirty = False
End Sub
Private Sub mnuFileOpen_Click()
cdlg.CancelError = True
On Error GoTo CancelOpen
cdlg.ShowOpen
mci.Command = "close" ’打开新的文件之前先要关闭已经打开的播放/录音
mci.FileName = cdlg.FileName
frmMain.MousePointer = 11
mci.Command = "open"
blnDirty = False
frmMain.MousePointer = 0
CancelOpen:
Exit Sub
End Sub
Private Sub mnuFileSaveAs_Click()
cdlg.Flags=cdlOFNOverwritePrompt+cdlOFNNoChangeDir+cdlOFNHideReadOnly’确认保存是否覆盖原来的文件以及保存的位置是打开的位置、不显示“只读”复选
cdlg.ShowSave
mci.FileName = cdlg.FileName
frmMain.MousePointer = 11
blnDirty = False
frmMain.MousePointer = 0
End Sub
这样,我们的录音机程序就编写完了。大家还可以在这个基础上按照自己的喜好来做进一步的修改,这个录音机程序不仅可以录音,也可以播放,它是没有录音时间限制的。至于它究竟可以录多久,笔者尝试用它录制了一个长达3个小时的文件,是完全没有问题的。
cso 2004-01-13
  • 打赏
  • 举报
回复
录制CD音轨
Public Sub RecordWave(TrackNum As Integer, Filename As String)
' Tracknum: track to record
' Filename: file to save wave as

On Local Error Resume Next
Dim i As Long, RS As String, cb As Long, t#
RS = Space$(128)

i = mciSendString("stop cdaudio", RS, 128, cb)
i = mciSendString("close cdaudio", RS, 128, cb)

Kill filename

RS = Space$(128)
i = mciSendString("status cdaudio position track " & TrackNum, RS, 128, cb)
i = mciSendString("open cdaudio", RS, 128, cb)
i = mciSendString("set cdaudio time format milliseconds", RS, 128, cb)
i = mciSendString("play cdaudio", RS, 128, cb)
i = mciSendString("open new type waveaudio alias capture", RS, 128, cb)
i = mciSendString("record capture", RS, 128, cb)

t# = Timer + 1: Do Until Timer > t#: DoEvents: Loop

i = mciSendString("save capture " & filename, RS, 128, cb)
i = mciSendString("stop cdaudio", RS, 128, cb)
i = mciSendString("close cdaudio", RS, 128, cb)

End Sub
cso 2004-01-13
  • 打赏
  • 举报
回复
录音如下,如果要压缩的话,VB是很难办到的,只有用解码器,现在的mp3制作软件都是利用第三方mp3解码器来实现mp3的制作的
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
进行录音
mciSendString "open new type waveaudio alias sounds", vbNull, 0, 0
mciSendString "record sounds", vbNull, 0, 0
中间请自己设置录音完成的判断
下面进行保存录音
With CommonDialog1
.FileName = ""
.Filter = "wav文件|*.wav"
.Flags = cdlOFNFileMustExist
.CancelError = True
End With
Dim cmtmp As String
CommonDialog1.ShowSave
cmtmp = "save sounds" & Space(1) & soundfile
mciExecute (cmtmp)
mciSendString "close sounds", vbNull, 0, 0

naojin 2004-01-13
  • 打赏
  • 举报
回复
也正是我要问的!
up

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧