调用GOOGLE语音朗读进行程序交互

hyy514

GOOGLE的在线翻译中有个很强大的功能,就是能将翻译后的内容生成音频文件进行朗读,
某天突发奇想,我能不能在线调用他来为我们朗读自已想要的内容呢?
调试了一下,是可以成功的.朗读的语音有点象外国人说中文,呵呵...
觉得挺有趣的,发上来共享一下,写成了函数,如下:

代码:

'************************************************ '*函数功能:调用GOOGLE进行中文语言朗读 '*函数无返回要朗读的中文以字符串传入参数sWord '*by:hyy514_2011.09 '************************************************ Private Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrcommand As String ) As Long Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( ByVal pCaller As Long ,  ByVal szURL As String ,  ByVal szFileName As String ,  ByVal dwReserved As Long ,  ByVal lpfnCB As Long ) As Long Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( ByVal nBufferLength As Long ,  ByVal lpBuffer As String ) As Long Private mciID As Integer Function GoogleSay( ByVal sWord As String )     Dim objJs    As Object     Dim sFile    As String     Dim sTmpPath As String         sTmpPath = Space(255)     GetTempPath 255, sTmpPath     sTmpPath = Left(sTmpPath, InStr(sTmpPath, Chr(0)) - 1)     sFile = sTmpPath & mciID Mod 2 & ".mp3"     mciID = mciID + 1     Set objJs = CreateObject("MSScriptControl.ScriptControl")     objJs.Language = "JavaScript"     sWord = objJs.Eval("encodeURI('" & Replace(sWord, "'", "\'") & "');")     URLDownloadToFile 0, "http://translate.google.cn/translate_tts?ie=UTF-8&q=" & sWord & "&tl=zh-CN&prev=input", sFile, 0, 0     mciExecute "play " & sFile End Function

可以这样调用:

代码:

Sub t() GoogleSay "来自Excelhome中文网 HYY5_1_4 " End Sub

示例文件:
googleSay.rar (8.31 KB, 下载次数: 522)

2011-9-23 19:35 上传

点击文件名下载附件

baomaboy

这个不错，收下，谢谢。
更关心的是楼主的代码关键字高亮是如何实现的，是用某个程序，还是楼主自己写的？

tonychris

呵呵，不错，很有创意。
但有一点要注意，使用 URLDownloadToFile 这个API的话，一定要先清空IE缓存

hyy514

baomaboy 发表于 2011-9-23 19:55
这个不错，收下，谢谢。
更关心的是楼主的代码关键字高亮是如何实现的，是用某个程序，还是楼主自己写的？

自已写的      

hyy514

自已写的一个小工具,如果你需要我可以传上来

baomaboy

hyy514 发表于 2011-9-23 20:02
自已写的一个小工具,如果你需要我可以传上来

那就谢谢了传上来也行，发给我也行{:soso_e183:}

hyy514

baomaboy 发表于 2011-9-23 20:04
那就谢谢了传上来也行，发给我也行

VB写的,复制你的代码到剪切板后,直接点击运行即可转换，必须在全版的发帖编辑框内才支持，快速回复中是不支持UBB的:
VbToUBB.rar (8.85 KB, 下载次数: 88)

2011-9-23 20:16 上传

点击文件名下载附件

要自定义式样,可以使用下列的配置方式,文件名为a.ini:
字体=
字号=
表头色=
背景色=
如你把下面的配置文件解压后，保存到VbToUBB.exe的同路径下，会配置另一种样式，你可以自行调整：

a.rar (251 Bytes, 下载次数: 84)

2011-9-23 20:15 上传

点击文件名下载附件

效果：

代码:

'************************************************ '*函数功能:调用GOOGLE进行中文语言朗读 '*函数无返回要朗读的中文以字符串传入参数sWord '*by:hyy514_2011.09 '************************************************ Private Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrcommand As String ) As Long Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( ByVal pCaller As Long ,  ByVal szURL As String ,  ByVal szFileName As String ,  ByVal dwReserved As Long ,  ByVal lpfnCB As Long ) As Long Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( ByVal nBufferLength As Long ,  ByVal lpBuffer As String ) As Long Private mciID As Integer Function GoogleSay( ByVal sWord As String )     Dim objJs    As Object     Dim sFile    As String     Dim sTmpPath As String         sTmpPath = Space(255)     GetTempPath 255, sTmpPath     sTmpPath = Left(sTmpPath, InStr(sTmpPath, Chr(0)) - 1)     sFile = sTmpPath & mciID Mod 2 & ".mp3"     mciID = mciID + 1     Set objJs = CreateObject("MSScriptControl.ScriptControl")     objJs.Language = "JavaScript"     sWord = objJs.Eval("encodeURI('" & Replace(sWord, "'", "\'") & "');")     URLDownloadToFile 0, "http://translate.google.cn/translate_tts?ie=UTF-8&q=" & sWord & "&tl=zh-CN&prev=input", sFile, 0, 0     mciExecute "play " & sFile End Function

kippon

好样的。 不错

baomaboy

hyy514 发表于 2011-9-23 20:15
VB写的,复制你的代码到剪切板后,直接点击运行即可转换，必须在全版的发帖编辑框内才支持，快速回复中是 ...

我以为是源码，不过还是谢谢了，其实我主要是想看下你有没有解决这种高亮着色代码的通病，就是是否优化了形如：
end if 、end sub 、 as long 的高亮颜色冗余部分。
''------------------------------------
忘了其实网页源码直接可看到，楼主的高亮程序也没优化那一部分，
end sub 之类，可以套一个颜色标签就行了，分开给每个关键字都套一个标签，如果代码量大的话还是很“占位”的......
可能是我的追求有些过分了.....
''-----------------------------------
另外楼主的高亮格式看着很舒服，改天套用一下放到我这个里面，谢谢了。
http://club.excelhome.net/thread-761432-1-1.html

代码:

'************************************************ '*函数功能:调用GOOGLE进行中文语言朗读 '*函数无返回要朗读的中文以字符串传入参数sWord '*by:hyy514_2011.09 '************************************************ Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrcommand As String) As Long Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private mciID As Integer Function GoogleSay(ByVal sWord As String)     Dim objJs    As Object     Dim sFile    As String     Dim sTmpPath As String         sTmpPath = Space(255)     GetTempPath 255, sTmpPath     sTmpPath = Left(sTmpPath, InStr(sTmpPath, Chr(0)) - 1)     sFile = sTmpPath & mciID Mod 2 & ".mp3"     mciID = mciID + 1     Set objJs = CreateObject("MSScriptControl.ScriptControl")     objJs.Language = "JavaScript"     sWord = objJs.Eval("encodeURI('" & Replace(sWord, "'", "\'") & "');")     URLDownloadToFile 0, "http://translate.google.cn/translate_tts?ie=UTF-8&q=" & sWord & "&tl=zh-CN&prev=input", sFile, 0, 0     mciExecute "play " & sFile End Function

lzqlaj

效果特别好，只是必须连接网络。。