08 April 2013

Fungsi Format RTF Untuk Pembuatan Kamus

Pernahkah anda menggunakan kamus 2.04 (Kamus Bahasa Inggris)? disana terdapat object richtexbox yang menerjemahkan bahasa inggris secara warna warni. Kamus tersebut dibuat dengan pemograman delphi .Nah, bagaimana kalau richtextbox di buat menggunakan pemograman visual basic 6.0?
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.


2 comments:

Recent Comment

Contact Form

Name

Email *

Message *

2012 © Jabat Software