Fungsi Format RTF Untuk Pembuatan Kamus Bahasa Inggris

Di bawah ini merupakan contoh format RTF untuk keperluan pembuatan kamus Bahasa Inggris. Fungsi di bawah ini dapat bekerja dengan sangat cepat? mengapa? karena ia tidak memformat tulisan pada objeknya secara langsung akan tetapi, memformat string yang terdapat dalam memori kemudian mem-feed-nya kembali ke dalam objek RichTextBox.

Bukankah:

Private Sub Command1_Click() 
    Dim i As Integer 
    For i = 1 To 1000 
        Text1.Text = Text1.Text & "contoh tulisan" & vbCrLf 
    Next 
End Sub 

Berbeda dengan kode di bawah ini:

Private Sub Command1_Click() 
    Dim i As Integer 
    Dim sText   As String 
    sText = Text1.Text 
    For i = 1 To 1000 
        sText = sText & "contoh tulisan" & vbCrLf 
    Next 
    Text1.Text = sText 
End Sub 

Sepintas dua kode di atas akan memberikan hasil yang sama akan tetapi berbeda jauh dalam segi kecepatan.

Di bawah ini merupakan fungsi format RTF untuk pembuatan kamus bahasa inggris:

Option Explicit 
 
Public Function FormatSentence(sSentence As String) As String 
    Dim sFormat As String 
    Dim sKosakata   As String 
    Dim sText As String 
    Dim i As Integer 
    sFormat = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" & vbCrLf & _ 
    "{\colortbl ;\red128\green0\blue0;\red0\green0\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green0\blue0;\red128\green0\blue128;}" & vbCrLf & _ 
    "{\*\generator Msftedit 5.41.15.1512;}\viewkind4\uc1\pard\ltrpar\lang1033\f0\fs17" 
    sKosakata = sSentence 
    sText = " " & Text1.Text 
    sText = Replace(sText, vbCrLf, " \Par"   & vbCrLf) 
    sText = Replace(sText, " kb. ", " \cf2\b kb. \cf0\b0 ") 
    sText = Replace(sText, " -kki. ", " \cf5\b kki. \cf0\b0 ") 
    sText = Replace(sText, " kk. ", " \cf1\b kk. \cf0\b0 ") 
    sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ") 
    sText = Replace(sText, " -ks. ", " \cf3\b -ks. \cf0\b0 ") 
    sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ") 
    sText =   Replace(sText, "(", "\cf5(\cf0 ") 
    sText = Replace(sText, ")", "\cf5)\cf0 ") 
    For i = 1 To 100 
        If InStr(1, sText, i) Then 
            sText = Replace(sText, " " & i & " ", " \b " & i & " \cf0\b0 ") 
        End If 
    Next 
    sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ") 
    sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ") 
    sText = sFormat & "\b " & sKosakata & "\b0 " & sText & "\par" & vbCrLf & "}" 
    FormatSentence = sText 
End Function 
 
Private Sub Form_Load() 
    RTF.BackColor = RGB(241, 243, 241) 
End Sub 

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    RTF.TextRTF = FormatSentence(Text2.Text) 
End Sub 

Maka hasilnya seperti gambar di bawah ini:

Catatan:
Fungsi di atas hanyalah sekadar contoh, Anda dapat memodifikasinya untuk disesuaikan dengan kebutuhan.

Download: Source code fungsi format RTF untuk Kamus Bahasa Inggris