用VB做一个TTS读文程序

软件世界

顾培忠

经过将近一个月的摸索，笔者手下的一个小程序终于告一段落，这就是“IQ读文v1.0beta”，它是一个利用TTS(Text to speech)引擎来实现中、英文朗读的程序。 程序虽然简单，但对于一个喜爱编程的人来说，其中还是有些地方值得重视的。
尽管TTS早就不是新鲜话题，但其作用可谓举足轻重，如现在的电话E-mail，某些人工智能以及许多非计算机领域都需要用到它。虽然在2003年将近的今天，TTS技术已比较先进，但在人性化方面，还是存在需要提高的地方，国内开发的TTS引擎尤其如此。笔者一向钟爱TTS，写本文的目的便是希望有更多的朋友也对TTS感兴趣，同时希望大家一起来探讨！
由于篇幅限制，文章只阐述编写过程中的重点。

一、选用外部控件

尽管能达到目的的 TTS 控件不是唯一，但微软的“Direct Text-to-Speech”控件(Xvoice.dll)功能强大，最为标准，请先获取该控件(普通安装 “Microsoft Speech API(SPCHAPI)” 即可)。
至于文本控件，我们选用“Microsoft Rich Textbox Control”(RichTX32.ocx)。
要实现文件操作，通常选用“Microsoft Common Dialog Control”(COMDLG32.ocx)。
另外，在“设置”时，经常用到“选项卡”，我们选用“Microsoft Tabbed Dialog Control”(TABCTL32.ocx)。

二、调用API函数

API(Application Program Interface，应用程序接口)是一个并不算太小的程序，我们应充分利用它。一般小型的32位Windows应用程序往往围绕于四大核心组件：ADVAPI32.DLL、GDI32.DLL、KERNEL32.DLL 以及 USER32.DLL。
API 函数的声明请使用 VB 带的“API 浏览器”。
如下是“IQ读文”调用的API函数：
GetWindowsDirectory;
GetForegroundWindow;
SetForegroundWindow;
SetWindowPos;
GetWindow;
GetWindowText;
GetCursorPos;
SetCursorPos;
GetFocus……
以及处理注册表的函数。

三、代码示例

1.获取引擎名称列表

以下“IQDW”为窗体名，“DirectSS”为TTS控件名，“ComboE”、“ComboC”为组合框名，分别显示英文、中文引擎名称。
On Error Resume Next
'仅在用户安装 TTS 的前提下才执行
If IQDW.DirectSS.CountEngines>0 Then
'如果出错，则表明没有可用的TTS
If Err then
……
'这里是没有可用 TTS 的代码...
Exit Sub
End If
'声明循环变量
Dim EI As Byte
For EI = 1 To IQDW.DirectSS.CountEngines
'“1033”为英文语言ID(中文为“2052”)
If IQDW.DirectSS.LanguageID(EI) = 1033 Then
'添加英文引擎名称
If EI < 10 Then
ComboE.AddItem ("No.0" & EI & ":" & IQDW.DirectSS.ModeName(EI))
'保持第一个英文引擎名
If ComboE.Text <> "" Then GoTo 10
ComboE.Text = "No.0" & EI & ":" & IQDW.DirectSS.ModeName(EI)
Else
ComboE.AddItem ("No." & EI & ":" & IQDW.DirectSS.ModeName(EI))
If ComboE.Text <> "" Then GoTo 10
ComboE.Text = "No." & EI & ":" & IQDW.DirectSS.ModeName(EI)
End If
Else
'添加中文引擎名称
If EI < 10 Then
ComboC.AddItem ("No.0" & EI & ":" & IQDW.DirectSS.ModeName(EI))
'保持第一个中文引擎名
If ComboC.Text <> "" Then GoTo 10
ComboC.Text = "No.0" & EI & ":" & IQDW.DirectSS.ModeName(EI)
Else
ComboC.AddItem ("No." & EI & ":" & IQDW.DirectSS.ModeName(EI))
If ComboC.Text <> "" Then GoTo 10
ComboC.Text = "No." & EI & ":" & IQDW.DirectSS.ModeName(EI)
End If
End If
10 Next
End If

2.实现文本自动跟读

下面的两个过程分别实现中文与英文的跟读，在需要时调用。“RTB”为 Rich Textbox 控件名。
Sub Ch()
Dim AllR, a As String
AllR = StrReverse(Mid(IQDW.RTB.Text, 1, IQDW.RTB.SelStart))
a = Mid(AllR, 1, 1)
'PitC、SpdC分别为中文语音频率、速度
IQDW.DirectSS.Pitch = PitC
IQDW.DirectSS.Speed = SpdC
IQDW.DirectSS.Speak a
End Sub
Sub En()
Dim AllR, a, W As String
Dim n As Byte
AllR = StrReverse(Mid(IQDW.RTB.Text, 1, IQDW.RTB.SelStart))
'PitE、SpdE分别为英文语音频率、速度
IQDW.DirectSS.Pitch = PitE
IQDW.DirectSS.Speed = SpdE
If Mid(AllR, 1, 1) <> " " Then
IQDW.DirectSS.Speak Mid(AllR, 1, 1)
Else
'朗读刚拼写出的单词
For n = 2 To 16
a = Mid(AllR, n, 1)
If a = " " Then Exit For
W = W & a
Next n
IQDW.DirectSS.Speak StrReverse(W)
End If
End Sub

3.迷你界面前置与移动

关于窗口前端显示，一般调用 “SetCursorPos” API 函数。在加载窗体时即可设置，如：
Sub Form_Load ()
……
'MiniF为窗体名，常数参数-1即指定为最前端。位置(Left、Top)根据自己使用的度量单位有所不同
SetCursorPos MiniF.hwnd, -1, MiniF.Left / 15, MiniF.Top / 15, 0, 0, 1
……
End Sub
但有时为了与同级别的窗体在一起(其他应用程序的窗口也为前端显示)也保持前端显示，我们可以用一个 Timer控件来实现(一般都没有这样做)，如：
'API函数GetFocus用于检测窗体是否拥有焦点
Private Declare Function GetFocus Lib "user32" () As Long
……
'自己设定Interval属性，如Timer1.Interval = 3000
Private Sub Timer1_Timer()
If GetFocus = 0 Then SetWindowPos MiniF.hwnd, -1, MiniF.Left/15, MiniF.Top/15, 0, 0, 1
End Sub
关于窗体的移动，如果操作系统不是 Win9X，系统默认的移动方式并不是直接移动，而是先移动产生一个轮廓框，鼠标释放或回车后再定位。但有时并不希望这样，而采用直接移动方式。这样可以从窗体可见的任何部位来移动，很多软件也都如此。通常使用MouseDown、MouseUp和MouseMove方法相结合来实现，如下：
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
'声明自定义类型
Private Type Point
X As Long
Y As Long
End Type
Dim P As Point
Dim A, B, C, D As Single
'鼠标按下开关
Dim IsMD As Boolean
Private Sub MiniF_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'得到当前位置
GetCursorPos P
A = P.X * 15
B = P.Y * 15
C = MiniF.Left
D = MiniF.Top
'鼠标已被按下
IsMD = True
End Sub
Private Sub MiniF_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetCursorPos P
'定位窗体
If IsMD = True Then
MiniF.Left = P.X * 15 - A + C
MiniF.Top = P.Y * 15 - B + D
End If
End Sub
Private Sub MiniF_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'鼠标已被释放
IsMD = False
End Sub
另外，为使窗体不“跑出”屏幕，可在 MouseUp 事件中加入下列代码：
If MiniF.Left < 0 Then MiniF.Left = 0
If MiniF.Top < 0 Then MiniF.Top = 0
If MiniF.Left + MiniF.Width > Screen.Width Then MiniF.Left = Screen.Width - MiniF.Width
If MiniF.Top + MiniF.Height > Screen.Height Then MiniF.Top = Screen.Height - MiniF.Height

四、结语

以上几点希望能对部分朋友有所帮助！期待着你的意见：iqwangzi@cmmail.com。让我们共同热爱TTS！