Deskripsi:
Ketika Anda mengetikkan teks yang datanya ada di dalam
combobox, maka otomatis program akan melengkapi data yang
sedang Anda ketik ke data yang mendekati atau yang Anda
inginkan. Tips ini juga sangat berguna bagi program Anda
jika menggunakan combobox yang di dalamnya terdiri dari
ratusan bahkan ribuan data. User akan kesulitan jika harus
memilih satu per satu dengan menscroll combobox ke bawah
hingga data yang diinginkan ketemu. Dengan adanya tips ini,
user cukup hanya mengetikkan beberapa karakter awal, dan
program akan otomatis melengkapinya, sehingga tidak perlu
mengetik sampai akhir. Tips ini juga berguna sekaligus
sebagai validasi data yang akan dipilih dari combobox,
harus cocok dengan data yang sudah tersedia sebelumnya.
dengan menambahkan parameter keempat untuk menentukan apakah
karakter yang ditampilkan di combobox bisa diubah atau
menggunakan karakter asli.
Persiapan:
1. Buat 1 Project baru dengan 1 Form.
2. Tambahkan lima combobox,
masing-masing menjadi: Combo1, Combo2,
Combo3, Combo4, dan Combo5.
3. Copy-kan coding berikut ke dalam editor form yang bertalian.
Option Explicit
'Konstanta untuk membantu pencarian string
Const CB_FINDSTRING = &H14C
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
'Untuk membantu menentukan apakah terjadi perubahan (Ubah)
'hasil string di combobox atau tidak (Asli).
Public Enum EnumKarakter
Asli = 0
Ubah = 1
End Enum
Dim Karakter As EnumKarakter
'Ini untuk mengisi setiap combobox dengan data yang sama
'Perhatikan perbedaan hasilnya saat data diketikkan di
'masing2 combobox ybt pada event procedure KeyPress...
Private Sub IsiSemuaCombobox()
Dim ctrl As Control
For Each ctrl In Form1.Controls
If TypeOf ctrl Is ComboBox Then
With ctrl
.AddItem "Masino Sinaga"
.AddItem "Marlyin Monroe"
.AddItem "Matt Monroe"
.AddItem "Ady Chandra"
.AddItem "Ari Hadiyono"
.AddItem "Dorce Simatupang"
.AddItem "Elvis Sinaga"
.Text = .List(0)
End With
End If
Next
End Sub
'Mula-mula, isi semua combobox dengan data yang sama
Private Sub Form_Load()
IsiSemuaCombobox
End Sub
'Bandingkan Combo1 dan Combo4...
'Hasilnya sama saja bukan? Karena huruf yang akan digunakan
'tidak terpengaruh kepada parameter ketiga (bUpperCase),
'tapi ditentukan oleh parameter keempat (cCharacter),
'yang bernilai "Asli", artinya menggunakan karakter aslinya.
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo1, KeyAscii, True, Asli)
End Sub
Private Sub Combo4_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo4, KeyAscii, False, Asli)
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo2, KeyAscii, False, Ubah)
End Sub
'Karena parameter ketiga = True, dan parameter keempat di-Ubah,
'maka huruf yang ditampilkan saat diketik akan menjadi
'huruf besar semuanya (terjadi perubahan karena "Ubah").
Private Sub Combo3_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo3, KeyAscii, True, Ubah)
End Sub
Private Sub Combo5_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo5, KeyAscii)
End Sub
Public Function AutoComplete( _
cbCombo As ComboBox, _
sKeyAscii As Integer, _
Optional bUpperCase As Boolean = True, _
Optional cCharacter As EnumKarakter = Asli) _
As Integer
Dim lngFind As Long, intPos As Integer
Dim intLength As Integer, tStr As String
With cbCombo
If sKeyAscii = 8 Then
If .SelStart = 0 Then Exit Function
.SelStart = .SelStart - 1
.SelLength = 32000
.SelText = ""
Else
'simpan posisi kursor
intPos = .SelStart
'simpan data string
tStr = .Text
'If bUpperCase = Asli Then
' .SelText = (Chr(sKeyAscii))
If bUpperCase = True Then
'ganti string. (hanya huruf besar)
.SelText = UCase(Chr(sKeyAscii))
Else 'If bUpperCase = KecilSemua Then
'ganti string. (biarkan data apa adanya)
.SelText = (Chr(sKeyAscii))
End If
End If
'Cari string di combobox
lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text)
If lngFind = -1 Then 'Jika string tidak ditemukan
'Set ke string yg lama (digunakan untuk data yang
'membutuhkan pengawasan karakter
.Text = tStr
'Tentukan posisi kursor
.SelStart = intPos
'Tentukan panjang yang terpilih
.SelLength = (Len(.Text) - intPos)
'Kembalikan nilai 0 KeyAscii (tidak melakukan apapun)
AutoComplete = 0
Exit Function
Else 'Jika string ditemukan
intPos = .SelStart 'Simpan posisi kursor
'Simpan panjang teks sisa yang disorot
intLength = Len(.List(lngFind)) - Len(.Text)
If cCharacter = Ubah Then
'Ganti teks baru dalam string (ubah seluruhnya)
.SelText = .SelText & Right(.List(lngFind), intLength)
Else 'Asli, huruf asli yang digunakan, tidak diganti
.Text = .List(lngFind)
End If
'Tentukan posisi kursor
.SelStart = intPos
'Tentukan panjang yang terpilih
.SelLength = intLength
End If
End With
End Function
1 komentar:
It’s actually a great and helpful piece of information. I am happy
that you shared this helpful information with us. Please stay us
informed like this. Thank you for sharing.
Printhead911
Posting Komentar