Selamat datang, dalam posting kali ini saya mencoba untuk membuat Aplikasi Buku Tamu Sederhana dengan menggunakan Microsoft Visual Basic 6.0
Dalam aplikasi ini kita menggunakan 2 buah form, yaitu form Mahasiswa dan Form menu menggunakan MDIForm. Untuk lebih jelasnya lihat gambar berikut.
Form Tampilan Utama Program
MDIForm Menu
Form siswa
Option Explicit
Dim Com1(10) As String
'Dim ADODC1.RECORDSET As ADODB.Recordset
Dim Ttext1 As String
Dim Cadangan As ListView
Dim Con As New ADODB.Connection
Dim Rec As ADODB.Recordset
Public Sub RefreshList()
Dim I As Integer
Dim Q As String
Dim jarak As Integer
Dim mitem
'If Text1.Text <> "" Then
If Text1.Text = "" Then
If Text2.Text = "" Then
Q = ""
Else
Q = " namainstansi LIKE '" & Trim(Text2) & "*'"
End If
Else
If Text2.Text = "" Then
Q = " nama LIKE '" & Trim(Text1.Text) & "*'"
Else
Q = " nama LIKE '" & Trim(Text1.Text) & "*' and namainstansi LIKE '" & Trim(Text2.Text) & "*'"
End If
End If
'End If
'StrSQL = "SELECT * FROM MAHASISWA " & Q
'Debug.Print StrSQL
'Adodc1.Recordset.Filter = Q
'Set ADODC1.RECORDSET = UConn.Execute(StrSQL)
Adodc1.Refresh
LV1.ListItems.Clear
' If ADODC1.RECORDSET.RecordCount = 0 Then
' 'Toolbar1.Buttons(2).Enabled = False
' 'Toolbar1.Buttons(3).Enabled = False
' Else
' 'Toolbar1.Buttons(2).Enabled = True
' 'Toolbar1.Buttons(3).Enabled = True
' 'ADODC1.RECORDSET.MoveFirst
'End If
Do While Not Adodc1.Recordset.EOF
I = I + 1
Set mitem = LV1.ListItems.Add(, , IIf(IsNull(Adodc1.Recordset.Fields("NAMA")), "", (Adodc1.Recordset.Fields("nama")))) '0
mitem.SubItems(1) = IIf(IsNull(Adodc1.Recordset.Fields("NAMAINSTANSI")), "", Adodc1.Recordset.Fields("namainstansi")) '1
mitem.SubItems(2) = IIf(IsNull(Adodc1.Recordset.Fields("TELP")), "", Adodc1.Recordset.Fields("telp")) '10
Adodc1.Recordset.MoveNext
If I = 1000 Then
I = 0
DoEvents
End If
Loop
'End If
'MDIFormMenu.StatusBar1.Panels(4).Text = "Total Member : " & ADODC1.RECORDSET.RecordCount
'ADODC1.RECORDSET.Close
'Set ADODC1.RECORDSET = Nothing
End Sub
Private Sub Combo1_Change()
RefreshList
End Sub
Private Sub Combo1_Click()
'Adodc1.Refresh
RefreshList
End Sub
Private Sub Command1_Click()
Con.Execute "insert into instansi values('" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) & "',#" & Format(Date, "yyyy-MM-dd") & "#)"
Con.Close
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\bukutamu.mdb;Persist Security Info=False"
Adodc1.Refresh
RefreshList
Text1.Text = ""
Text2 = ""
Text3 = ""
End Sub
Private Sub CoolBar1_HeightChanged(ByVal NewHeight As Single)
Form_Resize
End Sub
Private Sub Form_activate()
RefreshList
Text1.SetFocus
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyInsert
tambah
Case vbKeyEscape
Unload Me
Case vbKeyReturn
RefreshList
' Case vbKeyDelete
' Hapus
End Select
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim I As Integer
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\bukutamu.mdb;Persist Security Info=False"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\bukutamu.mdb;Persist Security Info=False"
Adodc1.RecordSource = "SELECT * FROM instansi"
Adodc1.Refresh
Com1(0) = "D3AKT"
Com1(1) = "D3MNJ"
Com1(2) = "S1AKT"
Com1(3) = "S1MNJ"
Com1(4) = "MI"
Com1(5) = "SI"
Com1(6) = "SK"
Com1(7) = "MK"
Com1(8) = "MS"
Com1(9) = "ALL"
For I = 1 To LV1.ColumnHeaders.Count
LV1.ColumnHeaders.Item(I).Icon = 0
Next
LV1.ColumnHeaders.Item(1).Icon = 1
Text1.Text = ""
End Sub
Private Sub Form_Resize()
CoolBar1.Width = Me.ScaleWidth
LV1.Top = Me.ScaleTop + CoolBar1.Height
LV1.Left = Me.ScaleLeft
LV1.Width = Me.ScaleWidth
LV1.Height = IIf(Me.ScaleHeight - CoolBar1.Height > 0, Me.ScaleHeight - CoolBar1.Height, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'MDIFormMenu.StatusBar1.Panels(4).Text = ""
End Sub
Private Sub LV1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim I As Byte
For I = 1 To LV1.ColumnHeaders.Count
LV1.ColumnHeaders.Item(I).Icon = 0
Next
If LV1.SortKey <> ColumnHeader.Index - 1 Then
LV1.SortOrder = lvwAscending
ColumnHeader.Icon = 1
LV1.SortKey = ColumnHeader.Index - 1
Else
If LV1.SortOrder = lvwAscending Then
LV1.SortOrder = lvwDescending
ColumnHeader.Icon = 2
Else
LV1.SortOrder = lvwAscending
ColumnHeader.Icon = 1
End If
End If
End Sub
Private Sub LV1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Menu.mnulap
End If
End Sub
'Private Sub Text1_Change()
' Cl.Getdata Me.Name, ADODC1.RECORDSET, Trim(Text1.Text), Ttext1, False
' Text1.ToolTipText = Ttext1
'MDIFormMenu.StatusBar1.Panels(5).Text = Ttext1
'End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'If KeyAscii = 13 Then RefreshList
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub LV1_DblClick()
If LV1.ListItems.Count = 0 Then
tambah
Else
perbaiki
End If
End Sub
Private Sub LV1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then LV1_DblClick
End Sub
Public Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
tambah
Case 2
perbaiki
Case 3
Call Hapus
Case 4
Call RefreshList
End Select
End Sub
Private Sub tambah()
End Sub
Private Sub perbaiki()
Menu.Cr1.DataFiles(0) = App.Path & "\bukutamu.MDB"
Menu.Cr1.ReportFileName = App.Path & "\instansi.rpt"
Menu.Cr1.WindowState = crptMaximized
Menu.Cr1.ReplaceSelectionFormula "{instansi.nama}='" & FrmMhs.LV1.SelectedItem.Text & "'"
Menu.Cr1.Destination = crptToPrinter
Menu.Cr1.Action = 0
Menu.Cr1.Destination = crptToWindow
Menu.Cr1.Action = 0
End Sub
Private Sub Hapus()
If MsgBox("Benar Data akan dihapus?", vbQuestion + vbYesNo, "Hapus") = vbYes Then
StrSQL = "delete from Mahasiswa where no_Mahasiswa='" & LV1.SelectedItem.Text & "'"
UConn.BeginTrans
UConn.Execute (StrSQL)
UConn.CommitTrans
RefreshList
End If
LV1.SetFocus
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
