吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 13910|回复: 65
收起左侧

[原创工具] 【源码】VB语音朗读3.0【可保存到文件】

[复制链接]
XhyEax 发表于 2014-12-16 21:34
本帖最后由 XhyEax 于 2015-3-22 21:40 编辑

5.1安装版(打包运行库[url=]已更新[/url]http://www.52pojie.cn/thread-343149-1-1.html

5.0(语速调整):http://www.52pojie.cn/thread-324600-1-1.html
4.0已更新(bug修复+美化):http://www.52pojie.cn/thread-322479-1-1.html
注:原版系统直接可用中英混读,ghost版被精简过的系统,请自行安装微软TTS语音引擎,不然只能读英文或者读不了,提示comdlg32.ocx丢失的请安装 微软常用运行库合集(地址在最后)
本软件为VB编写,调用微软TTS语音引擎,界面如图:(好吧,这是4.0)

444.jpg

最新源码在5.1处

全部源码:(如果你要要自行创建的话,请修改资源名为你的,并创建建和我的界面一样的界面,右下角那个可有可无,文本框、那个表格和按钮还有保存控件必须要有,
我的资源名:Txt_Show,Cmd_Pause,Cmd_Say,Cmd_Stop,VoiceL,SaveToWavCheckBox)
[Visual Basic] 纯文本查看 复制代码
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 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 = "暂停"
   Voice.Speak Txt_Show.Text, SVSFlagsAsync
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


下载:成品:
土豪通道:
VBSpeak3.0.exe.zip (5.94 KB, 下载次数: 11)
(谨防伸手党!已隐藏)
第一版、第二版、第三版和第四版 VB6.0企业精简版 微软常用运行库合集  免CB
下载地址:链接:http://pan.baidu.com/s/1mg2y86O 密码:4p76
已开源,求热心
第四版(bug修复+美化):http://www.52pojie.cn/thread-322479-1-1.html


第三版(可保存到文件):http://www.52pojie.cn/thread-313369-1-1.html
第二版(新增语言选择):http://www.52pojie.cn/thread-309985-1-1.html
第一版:http://www.52pojie.cn/thread-308146-1-1.html






免费评分

参与人数 6热心值 +6 收起 理由
玉树临风 + 1 谢谢@Thanks!
ttxz + 1 我很赞同!
peny1 + 1 谢谢@Thanks!
jmmes + 1 我很赞同!
Monitor + 1 鼓励转贴优秀软件安全工具和文档!
caijunqill + 1 感谢发布原创作品,吾爱破解论坛因你更精彩.

查看全部评分

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

 楼主| XhyEax 发表于 2014-12-16 21:35
二楼待编辑,欢迎点评
热心满10上源码
 楼主| XhyEax 发表于 2014-12-17 21:43
iamprole 发表于 2014-12-17 10:04
不错不错,继续努力,建议楼主再使用Mp3enc把wav格式音频编码成mp3格式,wav的文件体积太大了。

额,感觉还是原生比较好,不过,好吧,等下我试试
pbgz 发表于 2014-12-16 21:57
dongfang155 发表于 2014-12-16 22:05
这个很不错的,以前用过类似的软件
94fengying 发表于 2014-12-16 22:33
这是干什么的啊
jinglefly 发表于 2014-12-16 22:43
收藏备用,谢谢分享!
我好想你2014 发表于 2014-12-16 22:54
试试给力不呢
熊熊 发表于 2014-12-16 23:22
感谢分享了,支持了,语音库太少了
qeeqeeeq 发表于 2014-12-16 23:30
很好,,,很强大。。。。。。。。。。。。
f378694339 发表于 2014-12-17 09:38
看着还不错哦
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2024-11-25 00:54

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表