Code:
'Xu ly tieng Viet UNICODE
'Nguoi lap trinh: Nguyen Anh Cuong
'Website: http://khkt.net
'Email: trungtamtinhocabc@yahoo.com
'Mobile: 0988.529 310
'Ngay viet 8/5/2001
'Co tham khao cach giai quyet van de cua thay giao Le Duc Hong tren http://vivosoft.com
'Ngay sua chua gan nhat 6/10/06
Option Explicit
Public ABC As String
Public UNI_Co_Dau As String
' API de truy nhap VB6 String thong qua vi tri va thu tu cua no trong bo nho
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Enum coEncoding
coANSI = 0
coUnicode = 1
coUTF8 = 2
End Enum
Public Sub InitUnicode()
Dim ChuoiKQua As String
' Khoi tao danh sach cac ky tu tieng Viet co dau (UNI_Co_Daus), 67 ky tu co dau la chu thuong va 67 ky tu co dau la chu hoa
' Nen nho la dung cac ham Function chrW, ky tu &HE1 Unicode duoc chua ben trong danh sach nay
' nhu &HE100 cho 1 chuoiABC ky tu
ChuoiKQua = ChuoiKQua & ChrW(&HE1) & ChrW(&HE0) & ChrW(&H1EA3) & ChrW(&HE3) & ChrW(&H1EA1) & ChrW(&H103) & ChrW(&H1EAF) & ChrW(&H1EB1) & ChrW(&H1EB3) & ChrW(&H1EB5) & ChrW(&H1EB7) & ChrW(&HE2) & ChrW(&H1EA5) & ChrW(&H1EA7) & ChrW(&H1EA9) & ChrW(&H1EAB) & ChrW(&H1EAD) & ChrW(&HE9) & ChrW(&HE8) & ChrW(&H1EBB)
ChuoiKQua = ChuoiKQua & ChrW(&H1EBD) & ChrW(&H1EB9) & ChrW(&HEA) & ChrW(&H1EBF) & ChrW(&H1EC1) & ChrW(&H1EC3) & ChrW(&H1EC5) & ChrW(&H1EC7) & ChrW(&HED) & ChrW(&HEC) & ChrW(&H1EC9) & ChrW(&H129) & ChrW(&H1ECB) & ChrW(&HF3) & ChrW(&HF2) & ChrW(&H1ECF) & ChrW(&HF5) & ChrW(&H1ECD) & ChrW(&HF4) & ChrW(&H1ED1)
ChuoiKQua = ChuoiKQua & ChrW(&H1ED3) & ChrW(&H1ED5) & ChrW(&H1ED7) & ChrW(&H1ED9) & ChrW(&H1A1) & ChrW(&H1EDB) & ChrW(&H1EDD) & ChrW(&H1EDF) & ChrW(&H1EE1) & ChrW(&H1EE3) & ChrW(&HFA) & ChrW(&HF9) & ChrW(&H1EE7) & ChrW(&H169) & ChrW(&H1EE5) & ChrW(&H1B0) & ChrW(&H1EE9) & ChrW(&H1EEB) & ChrW(&H1EED) & ChrW(&H1EEF)
ChuoiKQua = ChuoiKQua & ChrW(&H1EF1) & ChrW(&HFD) & ChrW(&H1EF3) & ChrW(&H1EF7) & ChrW(&H1EF9) & ChrW(&H1EF5) & ChrW(&H111) & ChrW(&HC1) & ChrW(&HC0) & ChrW(&H1EA2) & ChrW(&HC3) & ChrW(&H1EA0) & ChrW(&H102) & ChrW(&H1EAE) & ChrW(&H1EB0) & ChrW(&H1EB2) & ChrW(&H1EB4) & ChrW(&H1EB6) & ChrW(&HC2) & ChrW(&H1EA4)
ChuoiKQua = ChuoiKQua & ChrW(&H1EA6) & ChrW(&H1EA8) & ChrW(&H1EAA) & ChrW(&H1EAC) & ChrW(&HC9) & ChrW(&HC8) & ChrW(&H1EBA) & ChrW(&H1EBC) & ChrW(&H1EB8) & ChrW(&HCA) & ChrW(&H1EBE) & ChrW(&H1EC0) & ChrW(&H1EC2) & ChrW(&H1EC4) & ChrW(&H1EC6) & ChrW(&HCD) & ChrW(&HCC) & ChrW(&H1EC8) & ChrW(&H128) & ChrW(&H1ECA)
ChuoiKQua = ChuoiKQua & ChrW(&HD3) & ChrW(&HD2) & ChrW(&H1ECE) & ChrW(&HD5) & ChrW(&H1ECC) & ChrW(&HD4) & ChrW(&H1ED0) & ChrW(&H1ED2) & ChrW(&H1ED4) & ChrW(&H1ED6) & ChrW(&H1ED8) & ChrW(&H1A0) & ChrW(&H1EDA) & ChrW(&H1EDC) & ChrW(&H1EDE) & ChrW(&H1EE0) & ChrW(&H1EE2) & ChrW(&HDA) & ChrW(&HD9) & ChrW(&H1EE6)
ChuoiKQua = ChuoiKQua & ChrW(&H168) & ChrW(&H1EE4) & ChrW(&H1AF) & ChrW(&H1EE8) & ChrW(&H1EEA) & ChrW(&H1EEC) & ChrW(&H1EEE) & ChrW(&H1EF0) & ChrW(&HDD) & ChrW(&H1EF2) & ChrW(&H1EF6) & ChrW(&H1EF8) & ChrW(&H1EF4) & ChrW(&H110)
UNI_Co_Dau = ChuoiKQua ' Gan vao danh sach UNI_Co_Dau
Dim ChuoiABC
ChuoiABC = ChuoiABC & ChrW(184) & ChrW(181) & ChrW(182) & ChrW(183) & ChrW(185) & ChrW(168) & ChrW(190) & ChrW(187) & ChrW(188) & ChrW(189) & ChrW(198) & ChrW(169) & ChrW(202) & ChrW(199) & ChrW(200) & ChrW(201) & ChrW(203) & ChrW(208) & ChrW(204) & ChrW(206) & ChrW(207) & ChrW(209) & ChrW(170) & ChrW(213) & ChrW(210) & ChrW(211) & ChrW(212) & ChrW(214) & ChrW(221) & ChrW(215)
ChuoiABC = ChuoiABC & ChrW(216) & ChrW(220) & ChrW(222) & ChrW(227) & ChrW(223) & ChrW(225) & ChrW(226) & ChrW(228) & ChrW(171) & ChrW(232) & ChrW(229) & ChrW(230) & ChrW(231) & ChrW(233) & ChrW(172) & ChrW(237) & ChrW(234) & ChrW(235) & ChrW(236) & ChrW(238) & ChrW(243) & ChrW(239) & ChrW(241) & ChrW(242) & ChrW(244) & ChrW(173) & ChrW(248) & ChrW(245) & ChrW(246) & ChrW(247) & ChrW(249) & ChrW(253) & ChrW(250) & ChrW(251) & ChrW(252) & ChrW(254) & ChrW(174) & ChrW(184)
ChuoiABC = ChuoiABC & ChrW(181) & ChrW(182) & ChrW(183) & ChrW(185) & ChrW(161) & ChrW(190) & ChrW(187) & ChrW(188) & ChrW(189) & ChrW(198) & ChrW(162) & ChrW(202) & ChrW(199) & ChrW(200) & ChrW(201) & ChrW(203) & ChrW(208) & ChrW(204) & ChrW(206) & ChrW(207) & ChrW(209) & ChrW(163) & ChrW(213) & ChrW(210) & ChrW(211) & ChrW(212) & ChrW(214) & ChrW(221) & ChrW(215) & ChrW(216)
ChuoiABC = ChuoiABC & ChrW(220) & ChrW(222) & ChrW(227) & ChrW(223) & ChrW(225) & ChrW(226) & ChrW(228) & ChrW(164) & ChrW(232) & ChrW(229) & ChrW(230) & ChrW(231) & ChrW(233) & ChrW(165) & ChrW(237) & ChrW(234) & ChrW(235) & ChrW(236) & ChrW(238) & ChrW(243) & ChrW(239) & ChrW(241) & ChrW(242) & ChrW(244) & ChrW(166) & ChrW(248) & ChrW(245) & ChrW(246) & ChrW(247) & ChrW(249)
ChuoiABC = ChuoiABC & ChrW(253) & ChrW(250) & ChrW(251) & ChrW(252) & ChrW(254) & ChrW(167)
ABC = ChuoiABC
End Sub
Function LaChuThuongCoDau(Ch) As Boolean
' Tra ve True neu Ch thuoc UNI_Co_Dau hoac dd, DD
LaChuThuongCoDau = (InStr(UNI_Co_Dau, Ch) > 0)
End Function
Function LaChuHoaCoDau(Ch) As Boolean
' Tra ve True neu Ch thuoc chua hoa cua Uppercase UNI_Co_Dau hoac DD
LaChuHoaCoDau = (InStr(UNI_Co_Dau, Ch) > 67)
End Function
Function Hoa1KyTu(Ch) As String
' Hoa 1 ky tu co dau neu no co trong danh sach vowel hoac dd
Dim ViTri ' Vi tri cua ky tu nay trong danh sach UNI_Co_Dau
' Co dinh ky tu trong danh sach UNI_Co_Daus
ViTri = InStr(UNI_Co_Dau, Ch)
If (ViTri > 67) Then
Hoa1KyTu = Ch ' No la ky tu hoa rui, thi giu nguyen no
ElseIf (ViTri > 0) Then
' Neu no la ky tu thuong, chon anh xa cua chu hoa tuong ung Uppercase vowel
Hoa1KyTu = Mid(UNI_Co_Dau, ViTri + 67, 1)
Else
' Neu no chi la ky tu ANSI (Chu k0 dau)
Hoa1KyTu = UCase(Ch)
End If
End Function
Function Thuong1KyTu(Ch) As String
' Tra ve chu thuong ky tu thuoc danh sach vowel hoac DD
Dim ViTri ' Vi tri cua ky tu nay trong danh sach UNI_Co_Dau
' Co dinh ky tu trong danh sach UNI_Co_Daus
ViTri = InStr(UNI_Co_Dau, Ch)
If ViTri > 67 Then
' Neu no la ky tu hoa, chon anh xa cua chu thuong tuong ung trong danh sach vowel
Thuong1KyTu = Mid(UNI_Co_Dau, ViTri - 67, 1)
ElseIf ViTri > 0 Then
Thuong1KyTu = Ch ' No la chu thuong, giu nguyen no
Else
' Neu no chi la ky tu ANSI (Chu k0 dau)
Thuong1KyTu = LCase(Ch)
End If
End Function
Function Hoa1Xau(ChuoiNguon) As String
' Chuyen 1 chuoi Unicode string thanh hoa
Dim I, DoDaiChuoi, ChuoiKQua
ChuoiKQua = "" ' Khoi tao chuoi ket qua
DoDaiChuoi = Len(ChuoiNguon) ' Nhan do dai chuoi Unicode string
If DoDaiChuoi > 0 Then
' Kiem tra va xu ly tung ky tu trong Unicode string
For I = 1 To DoDaiChuoi
' Chuyen tung ky tu mot thanh hoa
ChuoiKQua = ChuoiKQua & Hoa1KyTu(Mid(ChuoiNguon, I, 1))
Next
End If
Hoa1Xau = ChuoiKQua ' Tra lai chuoiABC ket qua
End Function
Function Thuong1Xau(ChuoiNguon) As String
' Chuyen 1 chuoi Unicode string thanh chu thuong
Dim I, DoDaiChuoi, ChuoiKQua
ChuoiKQua = "" ' Khoi tao chuoi ket qua
DoDaiChuoi = Len(ChuoiNguon) ' Nhan do dai chuoi Unicode string
If DoDaiChuoi > 0 Then
' Kiem tra va xu ly tung ky tu trong Unicode string
For I = 1 To DoDaiChuoi
' Chuyen tung ky tu mot thanh hoa
ChuoiKQua = ChuoiKQua & Thuong1KyTu(Mid(ChuoiNguon, I, 1))
Next
End If
Thuong1Xau = ChuoiKQua 'Tra lai chuoiABC ket qua
End Function
Sub HoaUNI()
Static DaHoa As Boolean
If Left(Selection.Font.Name, 1) <> "." Then
With Selection
Dim DongViet As String
DongViet = .Text
If DaHoa = True Then
DongViet = Hoa1Xau(DongViet)
Else
DongViet = Thuong1Xau(DongViet)
End If
DaHoa = Not DaHoa
Selection.Text = DongViet
End With
Else
Call HoaThuong
End If
End Sub
Sub HoaDaucauUNI()
Dim DongViet As String
Dim ChuanBiHoa As Boolean
Dim KyTu, DoDaiChuoi, I, kq As String
DongViet = Selection.Text
DoDaiChuoi = Len(DongViet)
If DoDaiChuoi > 0 Then
For I = 1 To DoDaiChuoi
KyTu = Mid(DongViet, I, 1)
If ChuanBiHoa = False Then
ChuanBiHoa = (KyTu = ".") Or (KyTu = ChrW(13)) Or (KyTu = "!") Or (KyTu = ":") Or (KyTu = "?") Or (KyTu = ";") Or (KyTu = "!")
ChuanBiHoa = ChuanBiHoa Or (KyTu = "(") Or (KyTu = "+")
ElseIf ChuanBiHoa And (KyTu <> " ") And (KyTu <> "-") And (KyTu <> "*") And (KyTu <> "+") And (KyTu <> ChrW(13)) And (KyTu <> ".") Then
KyTu = Hoa1KyTu(KyTu)
ChuanBiHoa = False
End If
kq = kq + KyTu
Next
End If
Selection.Text = kq
End Sub
Sub HoaDauTu()
Dim DongViet As String
Dim ChuanBiHoa As Boolean
Dim KyTu, DoDaiChuoi, I, kq As String
DongViet = Selection.Text
DoDaiChuoi = Len(DongViet)
If DoDaiChuoi > 0 Then
kq = Hoa1KyTu(Left(DongViet, 1))
For I = 2 To DoDaiChuoi
KyTu = Mid(DongViet, I, 1)
If ChuanBiHoa = False Then
ChuanBiHoa = (KyTu = ".") Or (KyTu = ChrW(13)) Or (KyTu = "!") Or (KyTu = ":") Or (KyTu = "?") Or (KyTu = ";") Or (KyTu = "!")
ChuanBiHoa = ChuanBiHoa Or (KyTu = "(") Or (KyTu = "+") Or (KyTu = " ")
ElseIf ChuanBiHoa And (KyTu <> " ") And (KyTu <> "-") And (KyTu <> "*") And (KyTu <> "+") And (KyTu <> ChrW(13)) And (KyTu <> ".") And (KyTu <> " ") Then
KyTu = Hoa1KyTu(KyTu)
ChuanBiHoa = False
End If
kq = kq + KyTu
Next
End If
Selection.Text = kq
End Sub
Function StringToString(Vowel1, Vowel2, Optional Chu) As String
Call InitUnicode
' Dich tung ky tu tu theo 2 ban do ky tu
Dim ConChu As String
Dim ChuoiGoc As String
Dim ChuoiDich As String
Dim I, ViTri
' Nap phan can dich
If IsMissing(Chu) Then
ChuoiGoc = Selection.Text
Else
ChuoiGoc = Chu
End If
' Kiem tra tung ky tu mot
For I = 1 To Len(ChuoiGoc)
ConChu = Mid(ChuoiGoc, I, 1)
' Bo qua Carriage Return va Line Feed neu co
If (ConChu = vbCr) Then
ChuoiDich = ChuoiDich & vbCr
ElseIf (ConChu = vbLf) Then
ChuoiDich = ChuoiDich & vbLf
Else
' Tim ky tu co dau trong danh sach
ViTri = InStr(Vowel1, ConChu)
If ViTri <= 0 Then
' Neu khong thay khong dung ban do
ChuoiDich = ChuoiDich & ConChu
Else
' Tim thay thi thay anh xa cua ky tu tuong ung
ChuoiDich = ChuoiDich & Mid(Vowel2, ViTri, 1)
End If
End If
Next
StringToString = ChuoiDich
End Function
Sub ABC2UNI()
Dim PhanChon As String
Application.ScreenUpdating = False
PhanChon = Selection.Text
Selection.Text = StringToString(ABC, UNI_Co_Dau)
Selection.Font.Name = "Arial"
Application.ScreenUpdating = True
End Sub
Sub UNI2ABC()
Dim PhanChon As String
Application.ScreenUpdating = False
PhanChon = Selection.Text
Selection.Text = StringToString(UNI_Co_Dau, ABC)
Selection.Font.Name = ".VnArial"
Application.ScreenUpdating = True
End Sub
'==== VNI Function
Function UnicodeToMultichar(XauUNI) As String
Call InitUnicode
Dim ConChu As String
Dim ChuoiGoc As String
Dim ChuoiDich As String
Dim I, ViTri, MangVNI
MangVNI = Array("aù", "aø", "aû", "aõ", "aï", "aê", "aé", "aè", "aú", "aü", "aë", "aâ", "aá", "aà", "aå", "aã", "aä", "eù", "eø", "eû", "eõ", "eï", "eâ", "eá", "eà", "eå", "eã", "eä", "í", "ì", "æ", "ó", "ò", "où", "oø", "oû", "oõ", "oï", "oâ", "oá", "oà", "oå", "oã", "oä", "ô", "ôù", "ôø", "ôû", "ôõ", "ôï", "uù", "uø", "uû", "uõ", "uï", "ö", "öù", "öø", "öû", "öõ", "öï", "yù", "yø", "yû", "yõ", "î", "ñ", "AÙ", "AØ", "AÛ", "AÕ", "AÏ", "AÊ", "AÉ", "AÈ", "AÚ", "AÜ", "AË", "AÂ", "AÁ", "AÀ", "AÅ", "AÃ", "AÄ", "EÙ", "EØ", "EÛ", "EÕ", "EÏ", "EÂ", "EÁ", "EÀ", "EÅ", "EÃ", "EÄ", "Í", "Ì", "Æ", "Ó", "Ò", "OÙ", "OØ", "OÛ", "OÕ", "OÏ", "OÂ", "OÁ", "OÀ", "OÅ", "OÃ", "OÄ", "Ô", "ÔÙ", "ÔØ", "ÔÛ", "ÔÕ", "ÔÏ", "UÙ", "UØ", "UÛ", "UÕ", "UÏ", "Ö", "ÖÙ", "ÖØ", "ÖÛ", "ÖÕ", "ÖÏ", "YÙ", "YØ", "YÛ", "YÕ", "Î", "Ñ")
'Gan noi dung can chuyen vao ChuoiGoc
ChuoiGoc = XauUNI
'Kiem tra lan luot tung ky tu trong xau
For I = 1 To Len(ChuoiGoc)
' Nhan mot ky tu Unicode
ConChu = Mid(ChuoiGoc, I, 1)
'Carriage return hoac LineFeedthi copy nguyen
If (ConChu = vbCr) Then
ChuoiDich = ChuoiDich & vbCr
ElseIf (ConChu = vbLf) Then
ChuoiDich = ChuoiDich & vbLf
Else
' Kiem tra vi tri cua ky tu trong mang danh sach UNI co dau?
ViTri = InStr(UNI_Co_Dau, ConChu)
If ViTri <= 0 Then
' neu khong phai chu co dau, giu nguyen
ChuoiDich = ChuoiDich & ConChu
Else
' Neu phai thi chon ky tu thay the tuong ung
ChuoiDich = ChuoiDich & MangVNI(ViTri - 1)
End If
End If
Next
'Tra ve ket qua
UnicodeToMultichar = ChuoiDich
End Function
Function MulticharToUnicode(XauUNI) As String
' Convert VNI sang UNICODE
Call InitUnicode
Dim ConChu As String
Dim ChuoiGoc As String
Dim ChuoiDich As String
Dim I, ViTri, SoThay, DoDaiChuoi
' Gan noi dung truyen vao ChuoiGoc
ChuoiGoc = XauUNI
' Thay the ky tu co dau trong ChuoiGoc voi mot xau dang 067 de xu ly
' thu tu 67th chu co dau
' Kiem tra tung ky tu co dau
Dim MangVNI, MangSo
MangVNI = Array("aù", "aø", "aû", "aõ", "aï", "aê", "aé", "aè", "aú", "aü", "aë", "aâ", "aá", "aà", "aå", "aã", "aä", "eù", "eø", "eû", "eõ", "eï", "eâ", "eá", "eà", "eå", "eã", "eä", "í", "ì", "æ", "ó", "ò", "où", "oø", "oû", "oõ", "oï", "oâ", "oá", "oà", "oå", "oã", "oä", "ô", "ôù", "ôø", "ôû", "ôõ", "ôï", "uù", "uø", "uû", "uõ", "uï", "ö", "öù", "öø", "öû", "öõ", "öï", "yù", "yø", "yû", "yõ", "î", "ñ", "AÙ", "AØ", "AÛ", "AÕ", "AÏ", "AÊ", "AÉ", "AÈ", "AÚ", "AÜ", "AË", "AÂ", "AÁ", "AÀ", "AÅ", "AÃ", "AÄ", "EÙ", "EØ", "EÛ", "EÕ", "EÏ", "EÂ", "EÁ", "EÀ", "EÅ", "EÃ", "EÄ", "Í", "Ì", "Æ", "Ó", "Ò", "OÙ", "OØ", "OÛ", "OÕ", "OÏ", "OÂ", "OÁ", "OÀ", "OÅ", "OÃ", "OÄ", "Ô", "ÔÙ", "ÔØ", "ÔÛ", "ÔÕ", "ÔÏ", "UÙ", "UØ", "UÛ", "UÕ", "UÏ", "Ö", "ÖÙ", "ÖØ", "ÖÛ", "ÖÕ", "ÖÏ", "YÙ", "YØ", "YÛ", "YÕ", "Î", "Ñ")
For I = 1 To 133
' Nhan tu danh sach
ConChu = MangVNI(I) ' Tu mang VNI
SoThay = "|" & Format(I, "000")
ChuoiGoc = Replace(ChuoiGoc, ConChu, SoThay) ' thay the tuong ung
Next
' Lam viec theo ban do tung ky tu
I = 1
DoDaiChuoi = Len(ChuoiGoc)
Do While I <= DoDaiChuoi
' Nhan mot ky tu
ConChu = Mid(ChuoiGoc, I, 1)
' Bo qua cac ky tu dac biet
If (ConChu = vbCr) Then
ChuoiDich = ChuoiDich & vbCr
I = I + 1
ElseIf (ConChu = vbLf) Then
ChuoiDich = ChuoiDich & vbLf
I = I + 1
Else
' Nhan vi tri trong chuoi goc
' de lam viec
ViTri = Val(Mid(ChuoiGoc, I + 1, 3))
If ViTri = 0 Then
ChuoiDich = ChuoiDich & ConChu
I = I + 1
Else
' Xuat ra chuoi dich voi ky tu tuong ung
ChuoiDich = ChuoiDich & Mid(UNI_Co_Dau, ViTri + 1, 1)
I = I + 4
End If
End If
Loop
' Tra ve ket qua
ChuoiDich = Replace(ChuoiDich, "aù", Mid(UNI_Co_Dau, 1, 1))
Dim MangThay, MangSai
MangThay = Array(ChrW(7901), ChrW(7907), ChrW(7899), ChrW(7903), ChrW(7913), ChrW(7915), ChrW(7919), ChrW(7905), ChrW(7917), ChrW(7921), ChrW(7898), ChrW(7900), ChrW(7902), ChrW(7904), ChrW(7906), ChrW(7912), ChrW(7914), ChrW(7920), ChrW(7916), ChrW(7918), ChrW(7920))
MangSai = Array(ChrW(417) & "ø", ChrW(417) & "ï", ChrW(417) & "ù", ChrW(417) & "û", ChrW(432) & "ù", ChrW(432) & "ø", ChrW(432) & "õ", ChrW(417) & "õ", ChrW(432) & "û", ChrW(432) & "ï", ChrW(416) & "Ù", ChrW(416) & "Ø", ChrW(416) & "Û", ChrW(416) & "Õ", ChrW(416) & "Ï", ChrW(431) & "Ù", ChrW(431) & "Ø", ChrW(431) & "Ø", ChrW(431) & "Û", ChrW(431) & "Õ", ChrW(431) & "Ï")
For I = 0 To 20
ChuoiDich = Replace(ChuoiDich, MangSai(I), MangThay(I))
Next
MulticharToUnicode = ChuoiDich
End Function
Sub UNI2VNI()
Selection.Text = UnicodeToMultichar(Selection.Text)
Selection.Font.Name = "VNI-Times"
End Sub
Sub VNI2UNI()
Selection.Text = MulticharToUnicode(Selection.Text)
Selection.Font.Name = "Courier New"
End Sub
Function abc22uni(Chu)
abc22uni = StringToString(ABC, UNI_Co_Dau, Chu)
End Function
Function uni22abc(Chu)
uni22abc = StringToString(UNI_Co_Dau, ABC, Chu)
End Function
Function KhongDau1Xau(ChuoiNguon) As String
' Chuyen 1 chuoi Unicode string thanh ky tu khong dau hoa
Dim I, DoDaiChuoi, ChuoiKQua
ChuoiKQua = "" ' Khoi tao chuoi ket qua
DoDaiChuoi = Len(ChuoiNguon) ' Nhan do dai chuoi Unicode string
If DoDaiChuoi > 0 Then
' Kiem tra va xu ly tung ky tu trong Unicode string
For I = 1 To DoDaiChuoi
' Chuyen tung ky tu mot thanh hoa
ChuoiKQua = ChuoiKQua & KhongDau1KyTu(Mid(ChuoiNguon, I, 1))
Next
End If
KhongDau1Xau = ChuoiKQua ' Tra lai chuoiABC ket qua
End Function
Function KhongDau1KyTu(Ch) As String
Dim ChuoiKQua As String, I
' Khoi tao danh sach cac ky tu tieng Viet co dau (UNI_Co_Daus), 67 ky tu co dau la chu thuong va 67 ky tu co dau la chu hoa
' Nen nho la dung cac ham Function chrW, ky tu &HE1 Unicode duoc chua ben trong danh sach nay
' nhu &HE100 cho 1 chuoiABC ky tu
ChuoiKQua = ChuoiKQua & ChrW(&HE1) & ChrW(&HE0) & ChrW(&H1EA3) & ChrW(&HE3) & ChrW(&H1EA1) & ChrW(&H103) & ChrW(&H1EAF) & ChrW(&H1EB1) & ChrW(&H1EB3) & ChrW(&H1EB5) & ChrW(&H1EB7) & ChrW(&HE2) & ChrW(&H1EA5) & ChrW(&H1EA7) & ChrW(&H1EA9) & ChrW(&H1EAB) & ChrW(&H1EAD) & ChrW(&HE9) & ChrW(&HE8) & ChrW(&H1EBB)
ChuoiKQua = ChuoiKQua & ChrW(&H1EBD) & ChrW(&H1EB9) & ChrW(&HEA) & ChrW(&H1EBF) & ChrW(&H1EC1) & ChrW(&H1EC3) & ChrW(&H1EC5) & ChrW(&H1EC7) & ChrW(&HED) & ChrW(&HEC) & ChrW(&H1EC9) & ChrW(&H129) & ChrW(&H1ECB) & ChrW(&HF3) & ChrW(&HF2) & ChrW(&H1ECF) & ChrW(&HF5) & ChrW(&H1ECD) & ChrW(&HF4) & ChrW(&H1ED1)
ChuoiKQua = ChuoiKQua & ChrW(&H1ED3) & ChrW(&H1ED5) & ChrW(&H1ED7) & ChrW(&H1ED9) & ChrW(&H1A1) & ChrW(&H1EDB) & ChrW(&H1EDD) & ChrW(&H1EDF) & ChrW(&H1EE1) & ChrW(&H1EE3) & ChrW(&HFA) & ChrW(&HF9) & ChrW(&H1EE7) & ChrW(&H169) & ChrW(&H1EE5) & ChrW(&H1B0) & ChrW(&H1EE9) & ChrW(&H1EEB) & ChrW(&H1EED) & ChrW(&H1EEF)
ChuoiKQua = ChuoiKQua & ChrW(&H1EF1) & ChrW(&HFD) & ChrW(&H1EF3) & ChrW(&H1EF7) & ChrW(&H1EF9) & ChrW(&H1EF5) & ChrW(&H111) & ChrW(&HC1) & ChrW(&HC0) & ChrW(&H1EA2) & ChrW(&HC3) & ChrW(&H1EA0) & ChrW(&H102) & ChrW(&H1EAE) & ChrW(&H1EB0) & ChrW(&H1EB2) & ChrW(&H1EB4) & ChrW(&H1EB6) & ChrW(&HC2) & ChrW(&H1EA4)
ChuoiKQua = ChuoiKQua & ChrW(&H1EA6) & ChrW(&H1EA8) & ChrW(&H1EAA) & ChrW(&H1EAC) & ChrW(&HC9) & ChrW(&HC8) & ChrW(&H1EBA) & ChrW(&H1EBC) & ChrW(&H1EB8) & ChrW(&HCA) & ChrW(&H1EBE) & ChrW(&H1EC0) & ChrW(&H1EC2) & ChrW(&H1EC4) & ChrW(&H1EC6) & ChrW(&HCD) & ChrW(&HCC) & ChrW(&H1EC8) & ChrW(&H128) & ChrW(&H1ECA)
ChuoiKQua = ChuoiKQua & ChrW(&HD3) & ChrW(&HD2) & ChrW(&H1ECE) & ChrW(&HD5) & ChrW(&H1ECC) & ChrW(&HD4) & ChrW(&H1ED0) & ChrW(&H1ED2) & ChrW(&H1ED4) & ChrW(&H1ED6) & ChrW(&H1ED8) & ChrW(&H1A0) & ChrW(&H1EDA) & ChrW(&H1EDC) & ChrW(&H1EDE) & ChrW(&H1EE0) & ChrW(&H1EE2) & ChrW(&HDA) & ChrW(&HD9) & ChrW(&H1EE6)
ChuoiKQua = ChuoiKQua & ChrW(&H168) & ChrW(&H1EE4) & ChrW(&H1AF) & ChrW(&H1EE8) & ChrW(&H1EEA) & ChrW(&H1EEC) & ChrW(&H1EEE) & ChrW(&H1EF0) & ChrW(&HDD) & ChrW(&H1EF2) & ChrW(&H1EF6) & ChrW(&H1EF8) & ChrW(&H1EF4) & ChrW(&H110)
UNI_Co_Dau = ChuoiKQua ' Gan vao danh sach UNI_Co_Dau
Dim ChuKhongDau
ChuKhongDau = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y", "D", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y", "D") ' Hoa 1 ky tu co dau neu no co trong danh sach vowel hoac dd
Dim ViTri ' Vi tri cua ky tu nay trong danh sach UNI_Co_Dau
' Co dinh ky tu trong danh sach UNI_Co_Daus
ViTri = InStr(UNI_Co_Dau, Ch)
If (ViTri > 0) Then
' Neu no la ky tu thuong, chon anh xa cua chu hoa tuong ung Uppercase vowel
KhongDau1KyTu = ChuKhongDau(ViTri)
Else
' Neu no chi la ky tu ANSI (Chu k0 dau)
KhongDau1KyTu = UCase(Ch)
End If
End Function
Public Sub InUnicode()
Dim ChuoiKQua As String, I
' Khoi tao danh sach cac ky tu tieng Viet co dau (UNI_Co_Daus), 67 ky tu co dau la chu thuong va 67 ky tu co dau la chu hoa
' Nen nho la dung cac ham Function chrW, ky tu &HE1 Unicode duoc chua ben trong danh sach nay
' nhu &HE100 cho 1 chuoiABC ky tu
ChuoiKQua = ChuoiKQua & ChrW(&HE1) & ChrW(&HE0) & ChrW(&H1EA3) & ChrW(&HE3) & ChrW(&H1EA1) & ChrW(&H103) & ChrW(&H1EAF) & ChrW(&H1EB1) & ChrW(&H1EB3) & ChrW(&H1EB5) & ChrW(&H1EB7) & ChrW(&HE2) & ChrW(&H1EA5) & ChrW(&H1EA7) & ChrW(&H1EA9) & ChrW(&H1EAB) & ChrW(&H1EAD) & ChrW(&HE9) & ChrW(&HE8) & ChrW(&H1EBB)
ChuoiKQua = ChuoiKQua & ChrW(&H1EBD) & ChrW(&H1EB9) & ChrW(&HEA) & ChrW(&H1EBF) & ChrW(&H1EC1) & ChrW(&H1EC3) & ChrW(&H1EC5) & ChrW(&H1EC7) & ChrW(&HED) & ChrW(&HEC) & ChrW(&H1EC9) & ChrW(&H129) & ChrW(&H1ECB) & ChrW(&HF3) & ChrW(&HF2) & ChrW(&H1ECF) & ChrW(&HF5) & ChrW(&H1ECD) & ChrW(&HF4) & ChrW(&H1ED1)
ChuoiKQua = ChuoiKQua & ChrW(&H1ED3) & ChrW(&H1ED5) & ChrW(&H1ED7) & ChrW(&H1ED9) & ChrW(&H1A1) & ChrW(&H1EDB) & ChrW(&H1EDD) & ChrW(&H1EDF) & ChrW(&H1EE1) & ChrW(&H1EE3) & ChrW(&HFA) & ChrW(&HF9) & ChrW(&H1EE7) & ChrW(&H169) & ChrW(&H1EE5) & ChrW(&H1B0) & ChrW(&H1EE9) & ChrW(&H1EEB) & ChrW(&H1EED) & ChrW(&H1EEF)
ChuoiKQua = ChuoiKQua & ChrW(&H1EF1) & ChrW(&HFD) & ChrW(&H1EF3) & ChrW(&H1EF7) & ChrW(&H1EF9) & ChrW(&H1EF5) & ChrW(&H111) & ChrW(&HC1) & ChrW(&HC0) & ChrW(&H1EA2) & ChrW(&HC3) & ChrW(&H1EA0) & ChrW(&H102) & ChrW(&H1EAE) & ChrW(&H1EB0) & ChrW(&H1EB2) & ChrW(&H1EB4) & ChrW(&H1EB6) & ChrW(&HC2) & ChrW(&H1EA4)
ChuoiKQua = ChuoiKQua & ChrW(&H1EA6) & ChrW(&H1EA8) & ChrW(&H1EAA) & ChrW(&H1EAC) & ChrW(&HC9) & ChrW(&HC8) & ChrW(&H1EBA) & ChrW(&H1EBC) & ChrW(&H1EB8) & ChrW(&HCA) & ChrW(&H1EBE) & ChrW(&H1EC0) & ChrW(&H1EC2) & ChrW(&H1EC4) & ChrW(&H1EC6) & ChrW(&HCD) & ChrW(&HCC) & ChrW(&H1EC8) & ChrW(&H128) & ChrW(&H1ECA)
ChuoiKQua = ChuoiKQua & ChrW(&HD3) & ChrW(&HD2) & ChrW(&H1ECE) & ChrW(&HD5) & ChrW(&H1ECC) & ChrW(&HD4) & ChrW(&H1ED0) & ChrW(&H1ED2) & ChrW(&H1ED4) & ChrW(&H1ED6) & ChrW(&H1ED8) & ChrW(&H1A0) & ChrW(&H1EDA) & ChrW(&H1EDC) & ChrW(&H1EDE) & ChrW(&H1EE0) & ChrW(&H1EE2) & ChrW(&HDA) & ChrW(&HD9) & ChrW(&H1EE6)
ChuoiKQua = ChuoiKQua & ChrW(&H168) & ChrW(&H1EE4) & ChrW(&H1AF) & ChrW(&H1EE8) & ChrW(&H1EEA) & ChrW(&H1EEC) & ChrW(&H1EEE) & ChrW(&H1EF0) & ChrW(&HDD) & ChrW(&H1EF2) & ChrW(&H1EF6) & ChrW(&H1EF8) & ChrW(&H1EF4) & ChrW(&H110)
UNI_Co_Dau = ChuoiKQua ' Gan vao danh sach UNI_Co_Dau
Dim ChuKhongDau
ChuKhongDau = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y", "D", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y", "D")
End Sub
Sub BoDau()
Selection.Text = KhongDau1Xau(Selection.Text)
End Sub
Sub HoaThuong()
Dim x As Integer
x = Windows.Count
If x = 0 Then
Exit Sub
End If
With Selection.Font
If Left(.Name, 1) = "." Then
If Right(.Name, 1) = "H" Then
.Name = Left(.Name, Len(.Name) - 1)
StatusBar = "Thôi không dùng Font hoa."
Else
.Name = .Name + "H"
StatusBar = "Sang Font hoa."
End If
Else
Call HoaUNI
End If
End With
End Sub
Bookmarks