VB 录音程序源代码

【实例简介】

VB 录音程序源代码

【实例截图】

【核心代码】

VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "PPT播放器"
   ClientHeight    =   1290
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   5550
   Icon            =   "Recorder.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1290
   ScaleWidth      =   5550
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog Cdlg 
      Left            =   2025
      Top             =   480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      Filter          =   "声音(*.wav)|*.wav|所有文件|*.*"
   End
   Begin VB.Timer Timer1 
      Interval        =   250
      Left            =   1425
      Top             =   720
   End
   Begin MSComctlLib.Slider Sl 
      Height          =   255
      Left            =   105
      TabIndex        =   1
      Top             =   360
      Width           =   5295
      _ExtentX        =   9340
      _ExtentY        =   450
      _Version        =   393216
      TickStyle       =   3
   End
   Begin MCI.MMControl MM 
      Height          =   495
      Left            =   105
      TabIndex        =   0
      Top             =   600
      Width           =   5340
      _ExtentX        =   9419
      _ExtentY        =   873
      _Version        =   393216
      PrevEnabled     =   -1  'True
      NextEnabled     =   -1  'True
      PlayEnabled     =   -1  'True
      PauseEnabled    =   -1  'True
      BackEnabled     =   -1  'True
      StepEnabled     =   -1  'True
      StopEnabled     =   -1  'True
      RecordEnabled   =   -1  'True
      EjectEnabled    =   -1  'True
      DeviceType      =   ""
      FileName        =   ""
   End
   Begin VB.Label Lb 
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      BackStyle       =   0  'Transparent
      Caption         =   "长度：  位置：0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808080&
      Height          =   210
      Left            =   225
      TabIndex        =   2
      Top             =   120
      Width           =   5055
   End
   Begin VB.Menu mnuNew 
      Caption         =   "新建(&N)"
   End
   Begin VB.Menu mnuOpen 
      Caption         =   "打开(&O)"
   End
   Begin VB.Menu mnuClose 
      Caption         =   "关闭(&C)"
   End
   Begin VB.Menu mnuSave 
      Caption         =   "保存(&S)"
   End
   Begin VB.Menu mnuSaveas 
      Caption         =   "另存为(&A)..."
   End
   Begin VB.Menu mnuExit 
      Caption         =   "退出(&E)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'Download by http://www.NewXing.com
'本程序作者: 周金锋
'
'作者信箱：jinfengnet@sina.com
'
'作者主页：http://jinfengnet.yeah.net
'
'金锋信息网欢迎您的到来，金锋编程园地会不断增加源代码，以供广大VB爱好者下载
'
'金锋信息网网址：http://jinfengnet.yeah.net
'

Private Sub Form_Load()
MM.Notify = False
MM.Wait = True
MM.Shareable = False
MM.DeviceType = "WaveAudio"
If Right$(App.Path, 1) = "\" Then Ph = App.Path Else Ph = App.Path & "\"
MM.Command = "close"
MM.FileName = Ph & "Recorder.wav"
MM.Command = "open"
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub


Private Sub mnuClose_Click()
    
    MM.Command = "close"
    
End Sub

Private Sub mnuExit_Click()

    Unload Me
    
End Sub

Private Sub mnuNew_Click()
    MM.Notify = False
    MM.Wait = True
    MM.Shareable = False
    MM.DeviceType = "WaveAudio"
    If Right$(App.Path, 1) = "\" Then Ph = App.Path Else Ph = App.Path & "\"
    MM.Command = "close"
    MM.FileName = Ph & "recorder.wav"
    MM.Command = "open"
    Sl.Value = 0
End Sub

Private Sub mnuOpen_Click()

    On Error Resume Next
    Cdlg.DialogTitle = "打开声音文件"
    Cdlg.ShowOpen
    If Err = 32755 Then Exit Sub
    MM.Command = "close"
    MM.FileName = Cdlg.FileName
    MM.Command = "open"

End Sub

Private Sub mnuSave_Click()

    On Error Resume Next
    If Right$(App.Path, 1) = "\" Then Ph = App.Path Else Ph = App.Path & "\"
    Cdlg.DialogTitle = "保存声音文件"
    If LCase(MM.FileName) = LCase(Ph & "recorder.wav") Then
    Cdlg.Flags = &H2
    Cdlg.ShowSave
    If Err = 32755 Then Exit Sub
    MM.FileName = Cdlg.FileName
    End If
    MM.Command = "save"
    
End Sub

Private Sub mnuSaveas_Click()

    On Error Resume Next
    If Right$(App.Path, 1) = "\" Then Ph = App.Path Else Ph = App.Path & "\"
    Cdlg.DialogTitle = "保存为另一个声音文件"
    Cdlg.Flags = &H2
    Cdlg.ShowSave
    If Err = 32755 Then Exit Sub
    MM.FileName = Cdlg.FileName
    MM.Command = "save"
    
End Sub

Private Sub Timer1_Timer()
On Error GoTo p0
Sl.Max = MM.Length
Sl.Value = MM.Position
p0:
Lb.Caption = "长度:" & MM.Length & " " & "位置:" & MM.Position
End Sub