frmsoundrecord.frm

VB6.0编写的医院影像系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSoundRecord 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "声音录制"
   ClientHeight    =   1335
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4965
   Icon            =   "frmSoundRecord.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   1335
   ScaleWidth      =   4965
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   855
      Left            =   2970
      Picture         =   "frmSoundRecord.frx":014A
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   75
      Width           =   975
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   855
      Left            =   3945
      Picture         =   "frmSoundRecord.frx":0A14
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   75
      Width           =   975
   End
   Begin MSComctlLib.ProgressBar pbr 
      Height          =   255
      Left            =   660
      TabIndex        =   4
      Top             =   990
      Visible         =   0   'False
      Width           =   735
      _ExtentX        =   1296
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   0
   End
   Begin VB.CommandButton cmdPlay 
      Caption         =   "回放"
      Enabled         =   0   'False
      Height          =   855
      Left            =   1995
      Picture         =   "frmSoundRecord.frx":12DE
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   75
      Width           =   975
   End
   Begin VB.CommandButton cmdStop 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   855
      Left            =   1020
      Picture         =   "frmSoundRecord.frx":1BA8
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   75
      Width           =   975
   End
   Begin VB.CommandButton cmdRecord 
      Caption         =   "录制"
      Height          =   855
      Left            =   45
      Picture         =   "frmSoundRecord.frx":2472
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   75
      Width           =   975
   End
   Begin MSComctlLib.StatusBar sbrSound 
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   1035
      Width           =   4965
      _ExtentX        =   8758
      _ExtentY        =   529
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   4974
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3704
            MinWidth        =   3704
            Text            =   "时间: "
            TextSave        =   "时间: "
            Key             =   "Time"
         EndProperty
      EndProperty
   End
   Begin VB.Timer tmrSound 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   2890
      Top             =   885
   End
End
Attribute VB_Name = "frmSoundRecord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public FileName As String
Public Cancel As Boolean
Public TimeStart
Public TimeEnd As Date

Public cMM As New Mmedia

Private Sub cmdCancel_Click()
    
    '取消
    Cancel = True
    Unload Me
    
End Sub

Private Sub cmdOK_Click()
    
    '确定
    Cancel = False
    Unload Me
    
End Sub

Private Sub cmdPlay_Click()
        
        
    '声音回放
    Dim RetValue As Long
    Dim ReturnStr As String * 255
    Dim TempStr As String
    
    'TempStr = "Play " & Filename
    '
    'RetValue = mciSendString(TempStr, ReturnStr, 256, 0)
    
    '回放声音
    With cMM
        .mmOpen FileName
        .mmPlay
    End With
    
End Sub

Private Sub cmdRecord_Click()
    
    '录音
    Dim RetValue As Long
    Dim ReturnStr As String * 255
    
    RetValue = mciSendString("Open New Type WaveAudio Alias Wave", ReturnStr, 256, 0)
    RetValue = mciSendString("Set Wave BitperSample 8", ReturnStr, 256, 0)
    RetValue = mciSendString("Set Wave Samplespersec 11025", ReturnStr, 256, 0)
    RetValue = mciSendString("Set Wave Channels 2", ReturnStr, 256, 0)
    RetValue = mciSendString("Record Wave", ReturnStr, 256, 0)
    cmdRecord.Enabled = False
    cmdStop.Enabled = True
    cmdPlay.Enabled = False
    
    '设置时间
    tmrSound.Enabled = True
    TimeStart = Time
    
End Sub

Private Sub cmdStop_Click()
    
    '停止录音
    Dim RetValue As Long
    Dim ReturnStr As String * 255
    Dim TempStr As String
    RetValue = mciSendString("Stop Wave", ReturnStr, 256, 0)
    TempStr = "Save Wave " & """" & FileName & """"
    RetValue = mciSendString(TempStr, ReturnStr, 256, 0)
    RetValue = mciSendString("Close Wave", ReturnStr, 256, 0)
    tmrSound.Enabled = False
    cmdRecord.Enabled = True
    cmdStop.Enabled = False
    cmdPlay.Enabled = True
    
End Sub



Private Sub Form_Load()
        
    '如果当前的声音存在,则允许播放
    
    
    If FileName <> vbNullString Then
        If FSO.FileExists(FileName) Then
            cmdPlay.Enabled = True
        End If
    End If
    
    Cancel = True
    
    '释放对象
    
    
End Sub

Private Sub tmrSound_Timer()
    

    sbrSound.Panels("Time").Text = "时间: " & Format(Time - TimeStart, "Nn:Ss") & " 秒"
    DoEvents
    
End Sub