Pada Artikel ini membahas pembuatan projeck Buku Kontak Telepon atau Phone Book dan cara mendesain form dan Penulisan Source code program membuat phone Book. Bermanfaat untuk praktikum atau latihan serta pengembangan projeck Phone Book dengan visual basic, serta dapat di pelajari untuk yang masih belajar programming visual basic karena di sertakan dengan desain, Source code, dan Properties dalam membuatnya. Silahkan ambil Source kode di Group "Belajar Visual Basic Indonesia"
3. Penulisan Source code
Form1 (Form Menu Utama)
Form2 (Form Tambah Data)
Form3 (Form Cari Data)
4. Jika semua sudah selesai�untuk menjalankan tekan F5
1. Buatlah Desain Form Buku kontak telepon atau phone book yang terdiri dari 3 form yaitu : form Menu utama , form tambah data, dan form mencari data telepon. Dapat di jadikan referensi jika masih bingung dengan desainya.
 |
| Desain Form |
2. Aturlah properties Ke- tiga form tersebut seperti contoh di bawah
3. Penulisan Source code
Form1 (Form Menu Utama)
Option Explicit
Private Sub ListView1_DblClick()
� Fungsi Double click
Form2.TxtNama = ListView1.SelectedItem
Form2.TxtTelp = ListView1.SelectedItem.SubItems(1)
cmdubah.Enabled = True
Call cmdubah_Click
End Sub
Private Sub CmdTambah_Click()
Form2.TxtNama = ""
Form2.TxtTelp = ""
Form2.Caption = "Tambah"
Form2.Show 1
End Sub
Private Sub CmdUbah_Click()
Form2.Caption = "Ubah"
Form2.Show 1
End Sub
Private Sub CmdHapus_Click()
If ListView1.ListItems.Count = 0 Then Exit Sub
�Menampilkan Pesan
If MsgBox("Anda yakin akan menghapus " & ListView1.SelectedItem & " dari daftar?", vbYesNo + vbDefaultButton2, "Hapus") = vbNo Then Exit Sub
ListView1.ListItems.Remove ListView1.SelectedItem.Index
End Sub
Private Sub CmdLoop_Click()
Dim I As Long
For I = 1 To ListView1.ListItems.Count
If MsgBox("Telp : " & ListView1.ListItems(I).ListSubItems(1), vbOKCancel, "Nama : " & ListView1.ListItems(I)) = vbCancel Then Exit For
Next I
End Sub
Private Sub CmdCari_Click()
Form3.Show 1
ListView1.SetFocus
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 107 Then Call CmdTambah_Click
If KeyCode = 46 Then Call CmdHapus_Click
If (Shift And vbCtrlMask) And KeyCode = vbKeyF Then Call CmdCari_Click
End Sub
Private Sub Form_Load()
With ListView1
.View = lvwReport
.ColumnHeaders.Add , , "NAMA"
.ColumnHeaders.Add , , "KONTAK"
AmbilData
'.Refresh
End With
CmdUbah.Enabled = False
Me.KeyPreview = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
SimpanData
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub ListView1_DblClick()
Form2.txtnama = ListView1.SelectedItem
Form2.txtTlp = ListView1.SelectedItem.SubItems(1)
CmdUbah.Enabled = True
Call CmdUbah_Click
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Form2.TxtNama = Item
Form2.TxtTlp = Item.ListSubItems(1)
CmdUbah.Enabled = True
End Sub
Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)
If (Shift And vbCtrlMask) Then CmdTambah.SetFocus
End Sub
Private Sub ListView1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call ListView1_DblClick
End Sub
Form2 (Form Tambah Data)
Option Explicit
Private Sub CmdSimpan_Click()
Dim Dpl As Long
Dpl = Duplikat(TxtNama)
If Dpl > 0 Then
If Form1.ListView1.ListItems(Form1.ListView1.SelectedItem.Index).Text <> TxtNama Then
MsgBox "Item tersebut sudah ada" & vbCrLf & "___________________" & vbCrLf & vbCrLf & "Nama : " & Form1.ListView1.ListItems(Dpl) & vbCrLf & "Telp : " & Form1.ListView1.ListItems(Dpl).ListSubItems(1), vbExclamation, "Duplikat"
TxtNama.SetFocus
Exit Sub
Else: GoTo Sini
End If
Else
If Me.Caption = "Tambah" Then
Dim li As ListItem
Set li = Form1.ListView1.ListItems.Add(, , TxtNama)
li.SubItems(1) = TxtTlp
SimpanData
AmbilData
Else
Sini:
If Form1.ListView1.ListItems.Count = 0 Then Exit Sub
Form1.ListView1.ListItems(Form1.ListView1.SelectedItem.Index).Text = TxtNama
Form1.ListView1.ListItems(Form1.ListView1.SelectedItem.Index).SubItems(1) = TxtTlp
End If
Call CmdBatal_Click
End If
End Sub
Private Sub CmdBatal _Click()
�Menutup Form
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys Chr(9)
If KeyCode = 27 Then CmdBatal _Click
End Sub
Private Sub Form_Load()
Me.KeyPreview = True
CmdSimpan.Enabled = False
End Sub
Private Sub TxtNama_Change()
CmdSimpan.Enabled = Len(TxtNama) > 0
End Sub
Private Sub TxtNama _GotFocus()
TxtNama.SelStart = 0
TxtNama.SelLength = Len(TxtNama)
End Sub
Private Sub TxtTelp_GotFocus()
TxtTelp.SelStart = 0
TxtTelp.SelLength = Len(TxtTelp)
End Sub
Private Sub TxtTelp _KeyPress(KeyAscii As Integer)
� Mengatur supaya hanya bisa angka
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then KeyAscii = 0
End Sub
Form3 (Form Cari Data)
Option Explicit
Dim Dx As Long
Private Sub CmdNext_Click()
If Not Dx = 0 Then Form1.ListView1.ListItems.Item(Dx).Bold = False
Dx = MatchBackward(TxtCari, Dx - 1)
If Dx > 0 Then
Form1.ListView1.ListItems(Dx).Selected = True
Form1.ListView1.ListItems.Item(Dx).Bold = True
Set Form1.ListView1.SelectedItem = Form1.ListView1.ListItems(Dx)
Form1.ListView1.SelectedItem.EnsureVisible
Label1.Caption = "Baris ke " & Dx
Else: Dx = Form1.ListView1.ListItems.Count
End If
End Sub
Private Sub CmdPrev_Click()
If Not Dx = 0 Then Form1.ListView1.ListItems.Item(Dx).Bold = False
Dx = Match(Text1, Dx + 1)
If Dx > 0 Then
Form1.ListView1.ListItems(Dx).Selected = True
Form1.ListView1.ListItems.Item(Dx).Bold = True
Set Form1.ListView1.SelectedItem = Form1.ListView1.ListItems(Dx)
Form1.ListView1.SelectedItem.EnsureVisible
Label1.Caption = "Baris ke " & Dx
End If
End Sub
Private Sub CmdCancel _Click()
If Not Dx = 0 Then Form1.ListView1.ListItems.Item(Dx).Bold = False
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Or KeyCode = vbKeyDown Then Call Command2_Click
If KeyCode = vbKeyUp Then Call CmdNext _Click
If KeyCode = 27 Then Call CmdCancel_Click
End Sub
Private Sub TxtCari _GotFocus()
TxtCari.SelStart = 0
TxtCari.SelLength = Len(TxtCari)
End Sub
Private Sub TxtCari _KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then KeyCode = 0
End Sub
Source Module
Option Explicit
Sub AmbilData()
Dim li As ListItem
Dim I As Long
Dim Tmp() As String
Dim TmpR() As String
With Form1.ListView1
Tmp = Split(GetSetting("BukuTelepon", "Y", "Y"), vbCrLf)
.ListItems.Clear
For I = LBound(Tmp) To UBound(Tmp)
TmpR = Split(Tmp(I), Chr(9))
If Tmp(I) <> "" Then Set li = .ListItems.Add(, , TmpR(0))
If UBound(TmpR) > 0 Then li.SubItems(1) = TmpR(1)
Next I
.Refresh
End With
End Sub
Sub SimpanData()
Dim Tmp As String
Dim I As Long
With Form1.ListView1
For I = 1 To .ListItems.Count
Tmp = Tmp & .ListItems(I) & Chr(9)
Tmp = Tmp & .ListItems(I).SubItems(1) & vbCrLf
Next I
SaveSetting "BukuTelepon", "Y", "Y", Tmp
End With
End Sub
Function Duplikat(Itemz As String) As Long
Dim I As Long
With Form1.ListView1
For I = 1 To .ListItems.Count
If LCase(.ListItems(I)) = LCase(Itemz) Then Duplikat = I: Exit For
Next I
End With
End Function
Function Match(Keyword As String, Start As Long) As Long
Dim I As Long
With Form1.ListView1
If Start = 0 Then Start = 1
For I = Start To .ListItems.Count
If LCase(.ListItems(I)) Like LCase("*" & Keyword & "*") Or LCase(.ListItems(I).SubItems(1)) Like LCase("*" & Keyword & "*") Then Match = I: Exit For
Next I
End With
End Function
Function MatchBackward(Keyword As String, Start As Long) As Long
Dim I As Long
With Form1.ListView1
If Start = 0 Then Start = .ListItems.Count
For I = Start To 1 Step -1
If LCase(.ListItems(I)) Like LCase("*" & Keyword & "*") Or LCase(.ListItems(I).SubItems(1)) Like LCase("*" & Keyword & "*") Then MatchBackward = I: Exit For
Next I
End With
End Function
4. Jika semua sudah selesai�untuk menjalankan tekan F5
Update Contact :
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email : Fajarudinsidik@gmail.com
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email: Fajarudinsidik@gmail.com
atau Kirimkan Private messanger melalui email dengan klik tombol order dibawah ini :
