Phát âm văn bản tiếng Việt với Vnspeech.dll

[truongphu]

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 + truongphu
Mô 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:

Syntax: [ Download ] [ Hide ]

Syntax: [ Download ] [ Show ]

Using vb Syntax Highlighting

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
 

Parsed in 0.009 seconds, using GeSHi 1.0.8.4

Form:
cần Text1, TextBox1 (form 2.0) và 3 command1, 2, 3

Syntax: [ Download ] [ Hide ]

Syntax: [ Download ] [ Show ]

Using vb Syntax Highlighting

 
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
 

Parsed in 0.011 seconds, using GeSHi 1.0.8.4

Project đính kèm có thư viện Vnspeech.dll

VietText To Speech.rar

(273.96 KiB) Đã tải về 1087 lần.