【免CB】VB语音朗读5.0【语速调整】

XhyEax

5.1安装版已更新（有bug暂停使用：http://www.52pojie.cn/thread-343149-1-1.html
注：原版系统直接可用中英混读，ghost版被精简过的系统，请自行安装微软TTS语音引擎，不然只能读英文或者读不了，提示comdlg32.ocx丢失的请安装 微软常用运行库合集
用途：循环播放古诗?给孩纸听写？用来加强记忆？好吧，我也不清楚。。。。。
本次更新内容：
1.语速可调整，从-10到10
2.文本添加版本号
（这次更新的较少，这是今年春节前最后一次更新了，感谢大家的建议！）
本软件为VB编写，调用微软TTS语音引擎，界面如图：

热心满10免CB
源码二楼

，加了一个控件和一句代码而已
下载： VBSpeak5.zip (6.65 KB, 下载次数: 206)

2015-2-1 18:44 上传

点击文件名下载附件
下载积分: 吾爱币 -2 CB

免CB：链接:http://pan.baidu.com/s/1mg2y86O 密码:4p76

dsong

特地来支持一下.

P.s.: 如果能中英混读就好了。我是指真正的中英混读，即可以自动切换两个语音库的，而不是双语语音库做出的“混读”。
我自己没有太多精力去尝试实现了，如果你愿意我可以提供思路：
把语音库标上序号1,2,3，比如1是中文，2是英语，然后自动搜索输入文本中的英语，检测到不是英语的就是中文了。(英语检测可以用是否是a,b,c,....,z来。)然后再英语开始加上隐藏的tag:<2>结束加上</2>，中文开始加上<1>结束加上</1>. 通过识别tag来进行语音库选择和切换.
另外相信你的屏幕分辨率比较大，而你要考虑到不同分辨率，你的程序在我这里启动的时候是在右下角的而且显示不全，需要手动拖动到正中央。对于这种问题的解决方法是:
假如你的窗体名字是Form1，那么你可以这样写代码:
if Form1.height<=screen.height then
Form1.left=(Screen.width-Form1.Width)/2
Form1.top=(Screen.height-Form1.height)/2
else
form1.top=0
form1.left=(Screen.width-form1.width)/2
end if
这样应该可以适应所有分辨率.

ii丶BigBreast

XhyEax

2223862765 发表于 2015-2-1 19:50
我的也是这种情况，代码没编好

那我下次把运行库集成一下吧。
还有啊，说代码没编好的，你既然这么厉害，那就你来写吧。

XhyEax

ii丶BigBreast 发表于 2015-2-1 18:59

微软常用运行库没有装全

XhyEax

f378694339 发表于 2015-2-1 18:51
还用不上 收藏先

为什么你总是二楼。。

XhyEax

源码在这里！

VB语音朗读5.0源码
语音朗读5.0源码：
如果你要要自行创建的话，请修改资源名为你的，并创建和我的界面一样的界面，文本框、comdlg32.ocx控件和按钮必须要有，
我的资源名：Txt_Show,Cmd_Pause,Cmd_Say,Cmd_Stop
/////////////////////////////////////////////////////////////////
Option Explicit
Dim Voice As SpVoice
Private Sub Form_Load()
    Set Voice = New SpVoice
    Dim Token As ISpeechObjectToken
    For Each Token In Voice.GetVoices
    VoiceL.AddItem (Token.GetDescription())
    Next
    VoiceL.ListIndex = 0
End Sub
Private Sub RateSldr_Click()
    Voice.Rate = RateSldr.Value
End Sub
Private Sub SaveToWavCheckBox_Click()
    If Cmd_Say.Caption = "朗读" Then
        Cmd_Say.Caption = "保存"
    Else
        Cmd_Say.Caption = "朗读"
    End If
End Sub
Private Sub Cmd_Say_Click()
    If Cmd_Pause.Caption = "恢复" Then Voice.Resume: Cmd_Pause.Caption = "暂停"
On Error GoTo Speak_Error
    If SaveToWavCheckBox Then
        SaveToWav
    Else
        If Not Txt_Show.Text = "" Then
            Voice.Speak Txt_Show.Text, SVSFlagsAsync
        End If
    End If
    Txt_Show.SetFocus
    Exit Sub
   
Speak_Error:
    MsgBox "朗读错误！", vbOKOnly
End Sub
Private Sub Cmd_Pause_Click()
    If Cmd_Pause.Caption = "暂停" Then
        Cmd_Pause.Caption = "恢复"
        Voice.Pause
    Else
        Cmd_Pause.Caption = "暂停"
        Voice.Resume
    End If
End Sub
Private Sub Cmd_Stop_Click()
    If Cmd_Pause.Caption = "恢复" Then Voice.Resume: Cmd_Pause.Caption = "暂停"
    Voice.Speak vbNullString, SVSFPurgeBeforeSpeak
End Sub
Private Sub SaveToWav()
    Dim cpFileStream As New SpFileStream
    cpFileStream.Format.Type = SAFT22kHz16BitMono
    ComDlg.CancelError = True
    On Error GoTo Cancel
    ComDlg.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNNoReadOnlyReturn
    ComDlg.DialogTitle = "保存至文件"
    ComDlg.Filter = "All Files (*.*)|*.*|Wave Files " & "(*.wav)|*.wav"
    ComDlg.FilterIndex = 2
    ComDlg.ShowSave
    cpFileStream.Open ComDlg.FileName, SSFMCreateForWrite, False
    Set Voice.AudioOutputStream = cpFileStream
    Voice.Speak Txt_Show.Text, SVSFDefault
    cpFileStream.Close
    Set cpFileStream = Nothing
    Set Voice.AudioOutputStream = Nothing
Cancel:
    Exit Sub
End Sub
Private Sub Txt_Show_KeyPress(KeyAscii As Integer)
'设置热键全选
If KeyAscii = 1 Then
        Txt_Show.SelStart = 0
        Txt_Show.SelLength = Len(Txt_Show.Text)
End If
End Sub
Private Sub Voice_EndStream(ByVal StreamNum As Long, ByVal StreamPos As Variant)
'    MsgBox "朗读完毕"
End Sub
Private Sub VoiceL_Click()
    ' 改变朗读语言
    Set Voice.Voice = Voice.GetVoices().Item(VoiceL.ListIndex)
    End Sub

///////////////////////////////////////////////////////////////////

f378694339

还用不上 收藏先

f378694339

XhyEax 发表于 2015-2-1 18:52
为什么你总是二楼。。

不欢迎我么 特地跑来支持你的

时光

感谢分享，谢谢

2223862765

ii丶BigBreast 发表于 2015-2-1 18:59

我的也是这种情况，代码没编好