Chuyển ký tự có dấu thành không dấu (Unicode to ASCII)

Tiếng Việt không dấu gây không mấy thiện cảm cho người đọc, nội dung thường phải đoán chừng; chưa kể do đoán sai nội dung sẽ gây ra hậu quả khác biệt nào đó.

Ấy thế nhưng tiếng Việt không dấu vẫn có nhu cầu, thường do các phần mềm ứng dụng không hổ trợ Unicode, lại phải chuyển từ tiếng Việt Unicode trở về không dấu (ASCII). Cần phân biệt ASCII với 128 bit sẽ không có dấu hoàn toàn, trong khi ANSI 256 bit lại rãi rác vài ký tự có dấu.

Code chuyển được viết với VB6:


Public Function UNItoASCII$(Str$)
    Dim Uni$: Uni = "áà" & W(7843) & "ã" & W(7841) & W(259) & W(7855) & W(7857) & W(7859) & W(7861) & W(7863) & "â" & W(7845) & W(7847) & W(7849) & W(7851) & W(7853) & W(273) & "éè" & W(7867) & W(7869) & W(7865) & "ê" & W(7871) & W(7873) & W(7875) & W(7877) & W(7879) & "íì" & W(7881) & W(297) & W(7883) & "óò" & W(7887) & "õ" & W(7885) & "ô" & W(7889) & W(7891) & W(7893) & W(7895) & W(7897) & W(417) & W(7899) & W(7901) & W(7903) & W(7905) & W(7907) & "úù" & W(7911) & W(361) & W(7909) & W(432) & W(7913) & W(7915) & W(7917) & W(7919) & W(7921) & "ý" & W(7923) & W(7927) & W(7929) & W(7925) & _
        "ÁÀ" & W(7842) & "Ã" & W(7840) & W(258) & W(7854) & W(7856) & W(7858) & W(7860) & W(7862) & "Â" & W(7844) & W(7846) & W(7848) & W(7850) & W(7852) & W(272) & "ÉÈ" & W(7866) & W(7868) & W(7864) & "Ê" & W(7870) & W(7872) & W(7874) & W(7876) & W(7878) & "ÍÌ" & W(7880) & W(296) & W(7882) & "ÓÒ" & W(7886) & "Õ" & W(7884) & "Ô" & W(7888) & W(7890) & W(7892) & W(7894) & W(7896) & W(416) & W(7898) & W(7900) & W(7902) & W(7904) & W(7906) & "ÚÙ" & W(7910) & W(360) & W(7908) & W(431) & W(7912) & W(7914) & W(7916) & W(7918) & W(7920) & "Ý" & W(7922) & W(7926) & W(7928) & W(7924)
    Dim Asci$: Asci = String(17, "a") & "d" & String(11, "e") & String(5, "i") & String(17, "o") & String(11, "u") & String(5, "y") & String(17, "A") & "D" & String(11, "E") & String(5, "I") & String(17, "O") & String(11, "U") & String(5, "Y")
    Dim S$, Temp$, K&, I&: I = Len(Str)
    For I = 1 To I
        S = Mid(Str, I, 1)
        K = InStr(1, Uni, S)
    If K Then
        Temp = Temp & Mid(Asci, K, 1)
    Else
        Temp = Temp & S
    End If
    Next ' truongphu@caulacbovb.com
    UNItoASCII = Temp
End Function


Function W(S As String) As String
    W = ChrW(S)
End Function


Private Sub Command1_Click()
    Text1 = UNItoASCII(TextBox1) ' TextBox1 có font thuôc Unicode
End Sub

Trong 2 function trên, Function W chỉ có nhiệm vụ  thu gọn ChrW thành W, mục đích để viết chuỗi Uni ngắn bớt.