语音合成与识别

开发平台：
Visual Basic

Form1.frm：源码内容
							VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{F5BE8BC2-7DE6-11D0-91FE-00C04FD701A5}#2.0#0"; "agentctl.dll"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Capture and Save to File Sample"
   ClientHeight    =   5250
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   4110
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5250
   ScaleWidth      =   4110
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdStandard 
      Caption         =   "标准发音"
      Height          =   375
      Left            =   2280
      TabIndex        =   8
      Top             =   1800
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      Height          =   2295
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   7
      Text            =   "Form1.frx":000C
      Top             =   2760
      Width           =   3375
   End
   Begin MSComDlg.CommonDialog svFile 
      Left            =   240
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Flags           =   4
   End
   Begin VB.CommandButton cmdStopPlaying 
      Caption         =   "停止回放"
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   1200
      Width           =   1455
   End
   Begin VB.CommandButton cmdSaveToFile 
      Caption         =   "保存到文件"
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   1800
      Width           =   1455
   End
   Begin VB.CommandButton cmdPlayRec 
      Caption         =   "录音回放"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   1200
      Width           =   1455
   End
   Begin VB.CommandButton cmdStopRec 
      Caption         =   "停止录音"
      Height          =   375
      Left            =   2280
      TabIndex        =   1
      Top             =   600
      Width           =   1455
   End
   Begin VB.Timer tmrCount 
      Left            =   840
      Top             =   840
   End
   Begin VB.CommandButton cmdStartRec 
      Caption         =   "开始录音"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   600
      Width           =   1455
   End
   Begin AgentObjectsCtl.Agent Agent1 
      Left            =   2760
      Top             =   2400
   End
   Begin VB.Label Label1 
      Caption         =   "输入文本"
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   2460
      Width           =   1695
   End
   Begin VB.Label lblLTime 
      Alignment       =   1  'Right Justify
      Caption         =   "剩余时间:"
      Height          =   255
      Left            =   360
      TabIndex        =   6
      Top             =   120
      Width           =   795
   End
   Begin VB.Label lblTIME 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label1"
      Height          =   255
      Left            =   1200
      TabIndex        =   5
      Top             =   120
      Width           =   1035
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件[&F]"
      Begin VB.Menu mnuExit 
         Caption         =   "退出[&X]"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dx As New DirectX7
Dim ds As DirectSound
Dim dsb As DirectSoundBuffer
Dim dsd As DSBUFFERDESC
Dim dsc As DirectSoundCapture
Dim dscb As DirectSoundCaptureBuffer
Dim dscd As DSCBUFFERDESC
Dim CaptureWave As WAVEFORMATEX
Dim capCURS As DSCURSORS
Dim ByteBuffer() As Integer
Dim CNT As Integer
Dim cCaps As DSCCAPS
Dim gfPlay As Boolean
Dim Genie As IAgentCtlCharacterEx
Private Sub cmdPlayRec_Click()
    '将音频捕捉缓冲转换为声音缓冲
    ConvertToSBuffer
    
    '判断声音缓冲是否建立成功。
    If dsb Is Nothing Then
        Exit Sub
    Else
        dsb.Play DSBPLAY_DEFAULT
        tmrCount.Enabled = True
        CNT = 0
        lblTIME.Caption = vbNullString
        If gfPlay Then cmdStopPlaying.Enabled = True
    End If
End Sub
Private Sub cmdSaveToFile_Click()
On Error Resume Next
    
    Dim FileLocal As String
    
    ConvertToSBuffer
    
    If dsb Is Nothing Then Exit Sub
    
    cmdStopPlaying.Enabled = False
    
    tmrCount.Enabled = False
    lblTIME.Caption = vbNullString
    CNT = 0
    
    If dsb Is Nothing Then
        MsgBox "你需要首先执行录音操作"
        Exit Sub
    End If
    
    svFile.Filter = "*.wav"
    svFile.DialogTitle = "保存音频文件"
    svFile.ShowSave
    
    If Right(svFile.FileName, 4) <> ".wav" And svFile.FileName <> vbNullString Then
        FileLocal = svFile.FileName
        FileLocal = FileLocal & ".wav"
    Else
        FileLocal = svFile.FileName
    End If
        
    If FileLocal = vbNullString Then Exit Sub
    
    If Mid(FileLocal, 2, 1) <> ":" Then Exit Sub
    
    If Right(FileLocal, 3) <> "wav" Then
        MsgBox "请输入音频文件的正确名字，例如 something.wav", vbApplicationModal
        Exit Sub
    End If
    
    dsb.SaveToFile FileLocal
End Sub
Private Sub cmdStandard_Click()
    If Text1.Text = "" Then
        MsgBox "你必须在文本框中输入语句", vbCritical, "错误"
        Exit Sub
    End If
    
    If Genie Is Nothing Then
        Agent1.Connected = True
        Agent1.Characters.Load "Genie"
        Set Genie = Agent1.Characters("Genie")
        If Genie Is Nothing Then End
        Genie.LanguageID = &H409
        Genie.SoundEffectsOn = True
    End If
    Genie.Show True
    Genie.Speak Text1.Text
End Sub
Private Sub cmdStartRec_Click()
    Set dscb = Nothing
    Call InitCapture
    
    dscb.start DSCBSTART_DEFAULT
    
    tmrCount.Interval = 1000
    tmrCount.Enabled = True
    cmdStopRec.Enabled = True
    cmdStartRec.Enabled = False
End Sub
Private Sub cmdStopPlaying_Click()
    
    If dsb Is Nothing Then Exit Sub
    
    Dim l_st As Long
    Dim l_soundStatus As Long
    
    '检测音频捕捉缓冲是否在处于运行状态。
    l_st = dscb.GetStatus()
    If (l_st And DSCBSTATUS_CAPTURING) Then
        dscb.Stop
    End If
    
    '检测音频捕捉是否处于播放状态
    l_soundStatus = dsb.GetStatus()
    If (l_soundStatus And DSBSTATUS_PLAYING) Then
        dsb.Stop
        dsb.SetCurrentPosition 0
    End If
    
    tmrCount.Enabled = False
    
    CNT = 0
    lblTIME.Caption = vbNullString
    cmdStopPlaying.Enabled = False
End Sub
Private Sub cmdStopRec_Click()
    Dim l_bufferS As Long
    
    If dscb Is Nothing Then Exit Sub
    
    cmdSaveToFile.Enabled = True
    If gfPlay Then cmdPlayRec.Enabled = True
    
    l_bufferS = dscb.GetStatus()
    If (l_bufferS And DSCBSTATUS_CAPTURING) Then
        dscb.Stop
    End If
    
    tmrCount.Enabled = False
    CNT = 0
    lblTIME.Caption = vbNullString
    cmdStartRec.Enabled = True
    cmdStopRec.Enabled = False
End Sub
Private Sub Form_Load()
    On Local Error GoTo errOut
    Set dsc = dx.DirectSoundCaptureCreate(vbNullString)
    On Error Resume Next
    Set ds = dx.DirectSoundCreate(vbNullString)
    If Err.Number = DSERR_ALLOCATED Then '声卡不支持全双工工作
        gfPlay = False
        MsgBox "声卡不支持全双工工作，但是仍然可以录音。", _
            vbOKOnly Or vbInformation, "不支持全双工"
    Else
        gfPlay = True
        ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
    End If
    On Local Error GoTo errOut
    
    '初始化音频捕捉
    InitCapture
    
    cmdSaveToFile.Enabled = False
    cmdPlayRec.Enabled = False
    cmdStopPlaying.Enabled = False
    cmdStopRec.Enabled = False
    
    lblTIME.Caption = vbNullString
    Text1.Text = ""
    Exit Sub
errOut:
    MsgBox "无法初始化声卡，退出程序", vbOKOnly Or vbCritical
    End
End Sub
Private Sub ConvertToSBuffer()
    Dim l_captureS As Long
    
    l_captureS = dscb.GetStatus()
    If (l_captureS And DSCBSTATUS_CAPTURING) Then
        dscb.Stop
    End If
    
    '获得音频捕捉信息
    dscb.GetCurrentPosition capCURS
    dsd.lBufferBytes = capCURS.lWrite * dscd.fxFormat.nBlockAlign
    dsd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC
    
    '无法写入
    If capCURS.lWrite = 0 Then
        Exit Sub
    End If
    
    Set dsb = ds.CreateSoundBuffer(dsd, dscd.fxFormat)
    ReDim ByteBuffer(capCURS.lWrite * dscd.fxFormat.nBlockAlign + 1)
    dscb.ReadBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), _
        DSCBLOCK_DEFAULT
    dsb.WriteBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), _
        DSBLOCK_DEFAULT
End Sub
Private Function WaveEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX
    WaveEx.nFormatTag = WAVE_FORMAT_PCM
    WaveEx.nChannels = Channels
    WaveEx.lSamplesPerSec = Hz
    WaveEx.nBitsPerSample = BITS
    WaveEx.nBlockAlign = Channels * BITS / 8
    WaveEx.lAvgBytesPerSec = WaveEx.lSamplesPerSec * WaveEx.nBlockAlign
    WaveEx.nSize = 0
End Function
Private Sub InitCapture()
    '设置音频捕捉缓冲
    dsc.GetCaps cCaps
    
    '设置采样频率以及精度
    If cCaps.lFormats And WAVE_FORMAT_2M08 Then
        CaptureWave = WaveEx(22050, 1, 8)
    ElseIf cCaps.lFormats And WAVE_FORMAT_1M08 Then
        CaptureWave = WaveEx(11025, 1, 8)
    Else
        MsgBox "你的声卡不支持音频捕捉！", vbApplicationModal
        End
    End If
    
    dscd.fxFormat = CaptureWave
    dscd.lBufferBytes = CaptureWave.lAvgBytesPerSec * 20
    dscd.lFlags = DSCBCAPS_WAVEMAPPED
    
    Set dscb = dsc.CreateCaptureBuffer(dscd)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call CleanUp
    End
End Sub
Private Sub CleanUp()
    '清除全部对象
    Set dx = Nothing
    Set ds = Nothing
    Set dsb = Nothing
    Set dsc = Nothing
    Set dscb = Nothing
    Set Genie = Nothing
    Agent1.Connected = False
    Erase ByteBuffer
End Sub
Private Sub mnuExit_Click()
    Unload Me
End Sub
Private Sub tmrCount_Timer()
On Error Resume Next
    
    CNT = CNT + 1
    
    If CNT = 19 Then
        dscb.Stop
        lblTIME.Caption = "Full"
        frmMain.Refresh
        tmrCount.Enabled = False
                
        cmdSaveToFile.Enabled = True
        If gfPlay Then cmdPlayRec.Enabled = True
        If gfPlay Then cmdStopPlaying.Enabled = True
        
        Exit Sub
    End If
    
    lblTIME.Caption = CNT
    
    '检测音频捕捉缓冲状态
    Dim l_sBs As Long
    If Not (dsb Is Nothing) Then
        l_sBs = dsb.GetStatus()
        If (l_sBs And DSBSTATUS_PLAYING) Then
        Else
            If cmdStartRec.Enabled = True Then
                tmrCount.Enabled = False
                CNT = 1
                lblTIME.Caption = vbNullString
                cmdStopPlaying.Enabled = False
            End If
        End If
    End If
End Sub

						