Cara membuat buku kontak telepon dengan visual basic

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"

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

Cara membuat buku kontak telepon dengan visual basic

Artikel Terkait Cara membuat buku kontak telepon dengan visual basic :

Suplemen Pria

Tutorial Populer

Artikel Terbaru

Kategori Desain

Temukan Kami