form1.frm

一个tts例子

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "考客(VER0.00版)"
   ClientHeight    =   6375
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7935
   LinkTopic       =   "Form1"
   ScaleHeight     =   6375
   ScaleWidth      =   7935
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   6600
      Top             =   240
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Interval        =   2000
      Left            =   7080
      Top             =   240
   End
   Begin VB.TextBox Texten 
      Height          =   3495
      HideSelection   =   0   'False
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   2520
      Width           =   7695
   End
   Begin VB.Label Label2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   840
      TabIndex        =   1
      Top             =   1440
      Width           =   7815
   End
   Begin VB.Label Label1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   36
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1095
      Left            =   840
      TabIndex        =   0
      Top             =   120
      Width           =   7575
   End
   Begin VB.Menu menu_open_text 
      Caption         =   "打开文本"
   End
   Begin VB.Menu menu_open_word 
      Caption         =   "打开单词"
   End
   Begin VB.Menu menu_about 
      Caption         =   "关于考客"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type enl_CNN_TYPE '一个数据类型，用来记录一个词句
    ENL As String '英文
    CNN As String '中文
End Type
Const DefaultFmt = "SAFT22kHz16BitMono"      '输出音频默认值
Dim enl_cnn_WORD(1 To 600) As enl_CNN_TYPE   '保存600个单词的数组
Dim speaker_IDX(0 To 20)               As Integer
Dim total_WORD                         As Integer
Dim play_SERIAL                        As Integer
Dim readTOKEN As Integer
'驱动器实例  讲英语 带事件
Dim WithEvents eVoice      As SpVoice
Attribute eVoice.VB_VarHelpID = -1
'驱动器实例  讲中文 不带事件
Dim cVoice                 As SpVoice
Private Sub Form_Load()
Dim i       As Integer


'试图装入msTTS驱动器
'************************************************************
On Error GoTo tts_err:

    App.Title = "考客(VER0.00版)"
    Dim Token         As ISpeechObjectToken
    Set eVoice = New SpVoice
    Set cVoice = New SpVoice
    '设置阅读速度
    eVoice.Rate = -1
    '初始化标记读者不可用
    For i = 0 To 20
    speaker_IDX(i) = -1
    Next
     
    '读取可以使用的语音驱动器
    i = 0
    For Each Token In eVoice.GetVoices
       
        '以下设置读者可用
        If Token.GetDescription() = "Microsoft Mary" Then
            speaker_IDX(1) = i
        ElseIf Token.GetDescription() = "Microsoft Mike" Then
            speaker_IDX(2) = i
        ElseIf Token.GetDescription() = "Microsoft Sam" Then
            speaker_IDX(3) = i
        ElseIf Token.GetDescription() = "Microsoft Simplified Chinese" Then
            speaker_IDX(4) = i
        ElseIf Token.GetDescription() = "中文女声语音(Ch.Female) [单机版]" Then
            speaker_IDX(5) = i
        End If
        i = i + 1
    Next
    
    '优先使用的发音者
    If speaker_IDX(1) <> -1 Then
      Set eVoice.Voice = eVoice.GetVoices().Item(speaker_IDX(1))
      ' MsgBox "由玛丽小姐给你阅读！"
    ElseIf speaker_IDX(2) <> -1 Then
      Set eVoice.Voice = eVoice.GetVoices().Item(speaker_IDX(2))
       'MsgBox "由迈克先生给你阅读！"
    ElseIf speaker_IDX(3) <> -1 Then
      Set eVoice.Voice = eVoice.GetVoices().Item(speaker_IDX(3))
       'MsgBox "由山姆大叔给你阅读！"
    End If
    
'优先使用中文的发音者
If speaker_IDX(5) <> -1 Then
      Set cVoice.Voice = cVoice.GetVoices().Item(speaker_IDX(5))
ElseIf speaker_IDX(4) <> -1 Then
      Set cVoice.Voice = cVoice.GetVoices().Item(speaker_IDX(4))
Else
      MsgBox "系统可能没有中文阅读驱动器"
End If

Exit Sub
tts_err:
End Sub




Private Sub menu_open_text_Click()
Dim fname          As String
Dim fno            As Integer
On Error GoTo ErrHandler
'-------------------------------------------------------------------------------------
     '以下设置打开文件对话框属性
    CommonDialog1.CancelError = True
    CommonDialog1.DialogTitle = "请选择你要打开的文件"
    CommonDialog1.InitDir = App.Path
    CommonDialog1.Filter = "文本文件*.txt|*.txt"
    CommonDialog1.FileName = "1.TXT"
    CommonDialog1.ShowOpen
    fname = CommonDialog1.FileName
'判断文件存在性
If Len(Dir$(fname)) = 0 Then
    Err.Raise 53 '文件没有找到
End If
Texten.Text = ""
fno = FreeFile()
Open fname For Binary Access Read As #fno
Texten.Text = StrConv(InputB$(LOF(fno), 1), vbUnicode)
Close fno

'停止上一次读
eVoice.Speak vbNullString, SVSFPurgeBeforeSpeak
cVoice.Speak vbNullString, SVSFPurgeBeforeSpeak
'开始读
eVoice.Speak Texten.Text, SVSFlagsAsync
readTOKEN = 1
Me.Caption = App.Title + "    " + fname

Exit Sub
ErrHandler:
End Sub

Private Sub menu_open_word_Click()
Dim fname, en           As String
Dim n, i, fno           As Integer
On Error GoTo ErrHandler                      '捕捉严重错误
    CommonDialog1.CancelError = True          '以下设置打开文件对话框属性
    CommonDialog1.DialogTitle = "请选择要打开的文件！"
    CommonDialog1.InitDir = App.Path
    CommonDialog1.Filter = "*.txt|*.txt;"
    CommonDialog1.DefaultExt = "txt"
    CommonDialog1.FileName = "单词第1课A.txt" '默认文件名
    CommonDialog1.ShowOpen
    fname = CommonDialog1.FileName            '从对话框取得文件名
'判断文件存在性
If Len(Dir$(fname)) = 0 Then
    Err.Raise 53 '文件没有找到
End If
   

i = 0
fno = FreeFile                        '取得自由文件号
Open fname For Input As #fno          '以 INPUT 方式打开文件
Do While Not EOF(fno) And i < 600     '把单词文件读到数组
   Input #fno, en                     '读入英文
   If en <> "" Then
    i = i + 1
    enl_cnn_WORD(i).ENL = en
    
    If Not EOF(fno) Then
    Input #fno, enl_cnn_WORD(i).CNN
    End If
                                      
  End If
Loop
Close fno

'停止上一次读
eVoice.Speak vbNullString, SVSFPurgeBeforeSpeak '停止上一次读
cVoice.Speak vbNullString, SVSFPurgeBeforeSpeak '停止上一次读
'单词总数
total_WORD = i
'读第一个单词或第一句
play_SERIAL = 1
'播放模式
readTOKEN = 0
Texten.Text = ""
Me.Caption = App.Title + "    " + fname
Exit Sub
ErrHandler:
Call MsgBox(Error$, 48)
End Sub


Private Sub Timer1_Timer()
Dim readEN, readCN As String

If readTOKEN = 0 Then
If total_WORD > 0 Then
'为了读和显示同步
If (eVoice.Status.RunningState = SRSEDone) And (cVoice.Status.RunningState = SRSEDone) Then
             '显示的文本
          readEN = enl_cnn_WORD(play_SERIAL).ENL
          readCN = enl_cnn_WORD(play_SERIAL).CNN
             '读英文
                     Label1.Caption = readEN
                     eVoice.Speak readEN, SVSFlagsAsync
             '读中文
                     Label2.Caption = readCN
                     cVoice.Speak readCN, SVSFlagsAsync
             '调整参数
                 play_SERIAL = play_SERIAL + 1
             If play_SERIAL > total_WORD Then
                '读完了回到第一个单词再读
                play_SERIAL = 1
             End If
End If
End If
End If
Exit Sub
ErrHandler:
End Sub
Private Sub eVoice_EndStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
 '一篇读完事件
 '自动重复读
  On Error GoTo ErrHandler
              '读文本
              If readTOKEN = 1 Then
                  eVoice.Speak Texten.Text, SVSFlagsAsync
              End If
Exit Sub
ErrHandler:
End Sub
Private Sub eVoice_Sentence(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)
 On Error GoTo ErrHandler
 If readTOKEN = 1 Then
    '高亮度显示当前读文本
     If Length > 0 Then
        Texten.SelStart = CharacterPosition
        Texten.SelLength = Length
     End If
End If
Exit Sub
ErrHandler:
End Sub
Private Sub menu_about_Click()
Call MsgBox("浙江省象山县定塘中学" + vbCrLf + "顾熙杰" + vbCrLf + "email:[e-mail]", 48)
End Sub