Thủ thuật: Phát âm văn bản tiếng Việt với Vnspeech.dll
Tác giả: Sưu tầm + truongphuMô tả: Phát âm văn bản tiếng Việt với Vnspeech.dll
Điều kiện bản quyền
Sản phẩm được xây dựng bởi Phòng Công nghệ Phần mềm (Softex) - Trung tâm Công nghệ Vi điện tử và Tin học,
Viện Ứng dụng Công nghệ - Bộ Khoa học và Công nghệ.
Phòng 413, C6 Thanh Xuân Bắc – Hà nội.
Tel. (04) 8547476; 0913079877
Việc sử dụng VNSpeech phải tuân thủ theo các quy định của tác giả:
- Phiên bản VnSpeech này được cung cấp để sử dụng cho mục đích học tập, nghiên cứu, không sử dụng cho các mục đích thương mại.
- Khi tích hợp với ứng dụng của bạn, đề nghị thêm dòng sau vào mục “About” của bạn: “Sử dụng thư viện Tổng hợp tiếng nói VnSpeech của Softex”
Nếu không tán thành các điều kiện trên, xin hãy xoá thư viện này khỏi máy của bạn.
phần mềm nầy tôi viết bổ sung để hoạt động trên font Unicode (gốc TCVN3)
Module:Declare Function VietTTS Lib "VNSPEECH.DLL" (ByVal test As String) As Integer
''''''''''''''''''''' Phâ`n Code trong VBLib
Public Const CF_UNICODETEXT As Long = 13
Public Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32.dll" () As Long
Public Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Public Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Function Get_clipboard() As String
Dim myStrPtr As Long, myLen As Long, myLock As Long, myData As String
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then MsgBox "Clipboard Text is not available now": Exit Function
myStrPtr = GetClipboardData(CF_UNICODETEXT)
If myStrPtr = 0 Then
MsgBox "Failed to get Clipboard Text"
Else
myLock = GlobalLock(myStrPtr)
myLen = GlobalSize(myStrPtr)
myData = String$(myLen \ 2 - 1, vbNullChar)
lstrcpy StrPtr(myData), myLock
GlobalUnlock myStrPtr
End If
CloseClipboard
Get_clipboard = myData
End Function
' code unitoabc truongphu
Public Function UNItoABC(str$) As String
Dim i&, arrABC() As String, sabc$, ABC$, uni$, STT
ABC = "¸@µ@¶@·@¹@¨@¾@»@¼@½@Æ@©@Ê@Ç@È@É@Ë@Ð@Ì@Î@Ï@Ñ@ª@Õ@Ò@Ó@Ô@Ö@Ý@×@Ø@Ü@Þ@ã@ß@á@â@ä@«@è@å@æ@ç@é@¬@í@ê@ë@ì@î@ó@ï@ñ@ò@ô@@ø@õ@ö@÷@ù@ý@ú@û@ü@þ@®@¸@µ@¶@·@¹@¡@¾@»@¼@½@Æ@¢@Ê@Ç@È@É@Ë@Ð@Ì@Î@Ï@Ñ@£@Õ@Ò@Ó@Ô@Ö@Ý@×@Ø@Ü@Þ@ã@ß@á@â@ä@¤@è@å@æ@ç@é@¥@í@ê@ë@ì@î@ó@ï@ñ@ò@ô@¦@ø@õ@ö@÷@ù@ý@ú@û@ü@þ@§"
uni = "02259224784302277841025978557857785978617863022678457847784978517853023302327867786978650234787178737875787778790237023678810297788302430242788702457885024478897891789378957897041778997901790379057907025092497911036179090432791379157917791979210253792379277929792502730225022478430227784102587855785778597861786301947845784778497851785302330232786778697865020278717873787578777879023702367881029778830243024278870245788502127889789178937895789704167899790179037905790702500249791103617909043179137915791779197921025379237927792979250272"
arrABC = Split(ABC, "@")
For i = 1 To Len(str$)
If InStr(uni, AscW(Mid(str$, i, 1))) > 0 And AscW(Mid(str$, i, 1)) > 127 Then
STT = InStr(uni, AscW(Mid(str$, i, 1))) \ 4
sabc = sabc & arrABC(STT)
Else
sabc = sabc & Mid(str$, i, 1)
End If
Next
UNItoABC = sabc
End Function
Form:cần Text1, TextBox1 (form 2.0) và 3 command1, 2, 3
[vb]
Private Sub Command1_Click()
Dim rev As Integer
rev = VietTTS(Text1.Text)
End Sub
Private Sub Command2_Click()
TextBox1 = ""
End Sub
Private Sub Command3_Click()
On Error Resume Next
Open App.Path & "\1.txt" For Binary As #1
Put #1, , Trim$(StrConv(Get_clipboard, vbUnicode))
Close #1
Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(App.Path & "\1.txt", 1, , -2)
TextBox1 = FSO.Readall
' Ðua unicode tu Clipboard lên textbox thât khó, qua nhiê`u công Ðoan
' truongphu, có le~ se~ viê't gon lai
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Kill App.Path & "\1.txt"
Kill App.Path & "\AbbrDic.txt"
End Sub
Private Sub Text1_Change()
If Len(Text1.Text) > 0 Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub TextBox1_Change()
Text1 = UNItoABC(TextBox1)
End Sub
[/vb]
Project đính kèm có thư viện Vnspeech.dll