Membuat Auto Complete pada Combo Box (VB)

Pada postingan kali ini saya akan membahas kembali mengenai Visual Basic yaitu Membuat Auto Complete pada Combo Box, maksud Auto Complete disini adalah Melengkapi Teks secara Otomatis pada saat sedang melakukan pengetikan ke data yang mendekati atau yang dinginkan, dengan catatan apabila data tersebut ada pada list data Combo Box tersebut.

Tip ini sangat berguna apabila menggunakan combobox yang di dalamnya terdiri atas ratusan bahkan ribuan data. User (pengguna/pemakai program) akan kesulitan jika harus memilih satu per satu menggunakan scroll combobox ke bawah hingga data yang diinginkan ketemu. Dengan adanya tip ini, user cukup hanya mengetikkan beberapa karakter awal, dan program akan otomatis melengkapinya, sehingga tidak perlu mengetik sampai akhir. Nah bagi yang berkenan untuk Tip ini silahkan ikuti langkah-lah berikut

• Buatlah Project Baru Standart Exe
• Tambahkan 1 buah ComboBox Style : Dropdown Combo
• Tambahkan 1 buah Module

'Ketik Coding berikut pada Module

Option Explicit

Const CB_FINDSTRING = &H14C

Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Public Enum EnumKarakter
Asli = 0
Ubah = 1
End Enum

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
intPos = .SelStart
tStr = .Text
If bUpperCase = True Then
.SelText = UCase(Chr(sKeyAscii))
Else
.SelText = (Chr(sKeyAscii))
End If
End If

lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, _
ByVal .Text)
If lngFind = -1 Then
Exit Function
Else
intPos = .SelStart
intLength = Len(.List(lngFind)) - Len(.Text)
If cCharacter = Ubah Then
.SelText = .SelText & Right(.List(lngFind), _
intLength)
Else
.Text = .List(lngFind)
End If
.SelStart = intPos
.SelLength = intLength
End If
End With
End Function

' Ketik Coding diberikut pada Form

Option Explicit

Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo1, KeyAscii, False, Asli)
End Sub

Private Sub Form_Load()
Call AddData
End Sub

Private Sub AddData()
With Combo1
.Clear
.AddItem "Ana Lestari"
.AddItem "Budi Setiawan"
.AddItem "Eka Syahputra"
.AddItem "Wahyu Perdana"
.AddItem "Blog walking"
.AddItem "Terserah"
End With
End Sub

Kemudian Run (jalankan) Program atau tekan F5, lalu pada combobox coba ketik huruf a , maka secara Otomatis teks pada combobox akan menjadi Ana Lestari. Semoga Tip ini ada mamfaat nya bagi kita semua, dan jangan lupa nitip komennya ya, terimakasih sebelumnya ... salam

Read More

Menampilkan Angka Terbilang dengan Visual Basic

Senang rasanya bisa berbagi lagi buat temen-temen karena udah lama gak posting, kali ini tentang cara Menampilkan Angka Terbilang dengan Visual Basic. Maksud angka terbilang disini adalah penulisan angka-angka dengan huruf misalnya Rp. 1.500 jadi (Seribu Lima Ratus Rupiah) tapi tip kali ini hanya untuk penulisan bilangan genap saja dan belum bisa digunakan untuk bilangan decimal atu bilangan berkoma, untuk menghemat waktu dan jangan capek ngetiknya (udah pasti neh) lanjut aja kita dengan cara pembuatan coding nya, nah bagi yang berkenan silakan ikuti langkah-langkah berikut

Persiapan yang dilakukan

• Buat Project Baru Standart Exe

• Tambahkan 1 buah TextBox dan 1 Label

• Tambahkan 1 buah Module

’Ketik Coding dibawah ini pada module

Option Explicit

Public Const vbKeyDecPt = 46
Public Function ConvertirEnText(ValNum As Double) As String

Static Unites(0 To 9) As String
Static Dixaines(0 To 9) As String
Static LesDixaines(0 To 9) As String
Static Milliers(0 To 4) As String

Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String

Unites(0) = "nol"
Unites(1) = "satu"
Unites(2) = "dua"
Unites(3) = "tiga"
Unites(4) = "empat"
Unites(5) = "lima"
Unites(6) = "enam"
Unites(7) = "tujuh"
Unites(8) = "delapan"
Unites(9) = "sembilan"

Dixaines(0) = "sepuluh"
Dixaines(1) = "sebelas"
Dixaines(2) = "dua belas"
Dixaines(3) = "tiga belas"
Dixaines(4) = "empat belas"
Dixaines(5) = "lima belas"
Dixaines(6) = "enam belas"
Dixaines(7) = "tujuh belas"
Dixaines(8) = "delapan belas"
Dixaines(9) = "sembilan belas"

LesDixaines(0) = ""
LesDixaines(1) = "sepuluh"
LesDixaines(2) = "dua puluh"
LesDixaines(3) = "tiga puluh"
LesDixaines(4) = "empat puluh"
LesDixaines(5) = "lima puluh"
LesDixaines(6) = "enam puluh"
LesDixaines(7) = "tujuh puluh"
LesDixaines(8) = "delapan puluh"
LesDixaines(9) = "sembilan puluh"

Milliers(0) = ""
Milliers(1) = "ribu"
Milliers(2) = "juta"
Milliers(3) = "milyard"
Milliers(4) = "triliyun"

On Error GoTo NbVersTexteError

strTemp = CStr(Int(ValNum)) 'Untuk Konversi Angka yang di format ke default

For i = Len(strTemp) To 1 Step -1
ValNb = Val(Mid$(strTemp, i, 1))
nPosition = (Len(strTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 1 Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = ""
End If
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
strResultat = LesDixaines(ValNb) & " " & _
strResultat
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " ratus " & _
strResultat
Else
strResultat = "seratus " & strResultat
End If
End If
End Select
Next i
If Len(strResultat) > 0 Then
strResultat = UCase$(Left$(strResultat, 1)) & _
Mid$(strResultat, 2)
End If

EndNbVersTexte:
ConvertirEnText = strResultat & " rupiah"
Exit Function

NbVersTexteError:
strResultat = "Une Erreur !"
Resume EndNbVersTexte
End Function

Public Function AngkaTerbilang(Counter As Double) As String
On Error Resume Next
Dim A As Single
AngkaTerbilang = ConvertirEnText(Counter)
A = Len(ConvertirEnText(Counter))
If Mid(ConvertirEnText(Counter), 1, 4) = "Ribu" Then
AngkaTerbilang = "Se" + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 4) = "Juta" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "Milyard" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
End Function

’Ketik Coding dibawah ini pada Form

Option Explicit

Private Sub Text1_Change()
If Text1 <> "" Then
Text1.Text = Format(Text1, "#,##0")
Text1.SelStart = Len(Text1)
Label1.Caption = AngkaTerbilang(Text1)
Label1.Caption = StrConv(Label1, vbProperCase)
Else
Label1.Caption = ""
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyDecPt Or KeyAscii = vbKeyBack Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub

Nah coba jalankan program atau tekan F5 dan isi beberapa angka pada Text1 akan secara otomatis angka terbilangnya akan ditampilkan pada Label1.

Mudah-mudahan ada mampaat nya bagi kita semua, dan jangan lupa beri komentar nya yah … sebelumnya saya ucapkan terima kasih ... wassalam

Read More

Contoh Pembuatan Program Trial Version (VB)

Program Versi Trial merupakan suatu Program atau Aplikasi yang sengaja dibuat menggunakan batas waktu tertentu sesuai keingingan si Software Maker, jadi apabila lewat batas waktu yg sudah ditentukan program tidak dapat digunakan lagi. Apabila pengguna sudah terlanjur menyukai program tersebut dan ingin menggunakan nya lagi, mau tidak mau pengguna harus memenuhi persyaratan yg diajukan oleh si software maker. Kebanyakan Program yg seperti ini digunakan sebagai sarana untuk mempromosikan suatu progam atau aplikasi.

Nah pada postingan kali ini saya coba membahas tentang contoh pembuatan program tersebut, bagi yang berkenan silakan ikuti langkah – langkah berikut :

- Buat Project Baru (Standart Exe)
- Tambah dua buah Label pada Form

Ketik code berikut pada Form

Option Explicit

Dim x
Dim y
Dim jumlah
Dim sisa

Private Sub Form_Load()
MsgBox "Program ini hanya dapat di gunakan 5 kali", 48, "Info"
x = GetSetting("y", "y", "y")
jumlah = Val(x) + 1
SaveSetting "Y", "Y", "Y", jumlah
Label1.Caption = "Program sudah dijalankan " & jumlah & " Kali"
sisa = 5 - jumlah
Label2.Caption = "Sisa pemakaian " & sisa & " Kali"

If jumlah > 5 Then
MsgBox "Batas waktu pemakaian sudah habis" + vbCrLf + _
"untuk menggunakan program ini lagi" + vbCrLf + _
"Anda harus menghubungi saya ....", 4, "Info"
Unload Me
End If

End Sub

Mudah – mudahan ada mampaat nya bagi kita semua … dan terimakasih bagi yang mau ngasih komen pada postingan ini …. Salam

Read More

Contoh Aplikasi Database Bag. II (VB6)

Pada kesempatan kali saya mencoba untuk berbagi lagi khusus bagi VB developer yg masih junior seperti saya tentang Pemrogram Database yg memakai Acces 2003 bagian 2, disini saya juga tidak menulis coding-coding nya karena lumayan panjang bisa pingsan jari saya kalaw ngetik nya hehehe … tapi temen-temen bisa mendownload nya. Aplikasi ini tentang Daftar Urut Kepangkatan (DUK) PNS yaitu cara menyortir Kepangkatan PNS yg merupakan Aplikasi saya yg ke dua untuk program database. Hal-hal yang dibahas dalam aplikasi antara lain :

1. Sortiran Data
2. Contoh sederhana tentang membuat program serial number (Trial Version)
3. Input Data
4. Edit Data
5. Hapus data
6. Output data (Mencetak Data) dengan Crystall Report
7. Backup Database
8. Compact Database
9. Mencopy dan menghapus file

Screen shot seperti gambar di bawah ini

Aplikasi ini belum final 100 % , dan agar program ini bisa berjalan dengan baik .. pastikan Settingan Format Tanggal pada komputer anda dd/mm/yyyy. Bagi yg ingin memodifikasi program ini saya persilahkan.

Yang berminat bisa mendownload nya disini … untuk password aplikasi ini 1234 Semoga ada mampaat nya bagi kita semua …. Terimakasih …salam

Read More

Contoh Aplikasi Database (VB6)

Masih seputaran postingan VB, kali ini saya akan berbagi sedikit tentang membuat program database yang memakai Ms. Acces 2003. Tapi disini saya tidak menuliskan coding-coding nya karena terlalu panjang sob, capek ngetiknya. Jadi sob bisa download langsung disini, Aplikasi ini tentang pencarian data pelanggan, input, edit, menghapus data dan mengexsport database ke excel file serta dilengkapi file setup nya kalau yang mau menginstall, Aplikasi ini merupakan Aplikasi saya yang pertama untuk pemrograman Database jadi coding nya masih belum begitu rapi hehehe. Bagi yang masih VB Beginner mohon konfirmasi dulu setelah mendownload karena aplikasi ini mempunyai Password. Screen shoot seperti gambar dibawah ini

mudah-mudahan ada mamfaat nya bagi kita semua, bagi yang nyedot jangan lupa ya titip komentar nya .. makasih

User Name : telkom
Password : telkom

Read More

Control ActiveX VB Part2

Dalam membuat sebuah Aplikasi (Program) Tampilan atau design program sangat lah menunjang bagi puas nya user (pengguna program) dan Software maker itu sendiri (ciaaah), disini saya mencoba membagikan sedikit ilmu yang saya dapat untuk menunjang design tampilan tersebut yang merupakan Control ActiveX (komponen tambahan), Button adalah salah satu nya. Kalau anda tertarik bisa anda dapatkan disini dan jangan lupa baca dulu Readme nya ada panduan sedikit disana, gimana style button nya .. liat aja dibawah.

gimana ....... cool-cool kan (yaa iyaa lah gak pake' iyang donk). Kalau nyedot jangan lupa koment nya bro, mudah2an anda mamfaat nya bagi anda ... thanx (eRGe)

Read More

Mencari Selisih Tanggal (VB6)

Saya coba berbagi lagi neh untuk para junior VB ataw yang baru blajar VB tentang mencari selisih tanggal, untuk eksperimen .. saya coba menerapkannya pada contoh project dibawah ini yaitu tentang menghitung umur, bagi yang berkenan silakan ikuti langkah2 berikut

persiapan yang dilakukan :

• Buatlah Project Baru (Standard exe)
• Tambahkan :
• 3 Label
• Label1 (Caption : Mencari Selisih Tanggal)
• Label2 (Caption : Lahir :)
• Label3 (Caption : Umur Anda)
• 1 Buah Frame ------> Caption : Masukan Tanggal Lahir
  
• 3 Buah ComboBox ----> Style : 2 - Dropdown List
• 1 Buah Command Button

yang kurang lebih penampakannya seperti gambar dibawah ini

kemudian ketik Coding dibawah ini pada Form

Option Explicit

Private Sub showTanggal()
Dim i As Byte
For i = 1 To 31
Combo1.AddItem Format(i, "00")
Next i
Combo1.ListIndex = 0
End Sub

Private Sub showBulan()
Dim i As Byte
For i = 1 To 12
Combo2.AddItem Format(i, "00")
Next i
Combo2.ListIndex = 0
End Sub

Private Sub showTahun()
Dim i As Integer
For i = 1950 To Year(Now)
Combo3.AddItem i
Next i
Combo3.ListIndex = 0
End Sub

Private Sub Command1_Click()
Dim sLahir As String
sLahir = Combo1 + "/" + Combo2 + "/" + Combo3
If IsDate(sLahir) = True Then
Label3.Caption = "Umur anda sekarang : " & SelisihTanggal(CDate(sLahir), Date)
Else
MsgBox "Tanggal nya salah coy", 48, "Info"
Combo1.SetFocus
End If
End Sub

Private Sub Form_Load()
showTanggal
showBulan
showTahun
End Sub

Private Function SelisihTanggal(ByVal TanggalAwal As _
Date, ByVal TanggalAkhir As Date) As String

Dim Tahun As Integer, Sisa As Integer
Dim SelisihBulan As Integer
On Error GoTo pesan
SelisihBulan = DateDiff("m", TanggalAwal, TanggalAkhir)
Tahun = SelisihBulan \ 12
Sisa = SelisihBulan Mod 12
SelisihTanggal = Tahun & " Tahun " & Sisa & " Bulan"
Exit Function
pesan:
MsgBox "Tipe Tanggal Salah!", vbCritical, "Error TAnggal"
End Function

Mudah2an ada manfaat nya bagi rekan2 VB Beginner dan selamat mencoba jangan lupa nitip comment nya .. makasih salam ..

Read More