Saturday, April 20, 2013

Listing Code Program Peminjaman Buku pada Visual Basic

DATA BUKU 
 
LISTING PROGRAM :
Private Sub CMDBATAL_Click()
NONAKTIF
BERSIH
CMDTAMBAH.SetFocus
End Sub
Private Sub CMDHAPUS_Click()
On Error GoTo errhapus
Dim a As String
a = MsgBox("Yakin Mau Hapus ?", vbInformation + vbYesNo, "Data Buku")
    If a = vbYes Then
        Data1.Recordset.Delete
        MsgBox "Data Telah Dihapus !", vbInformation + vbOKOnly, "Data Buku"
    Else
        NONAKTIF
        BERSIH
        CMDTAMBAH.SetFocus
    End If
    Exit Sub
   
errhapus:
MsgBox "Data Gagal Menghapus !", vbCritical + vbOKOnly, "Data Buku"
End Sub
Private Sub CMDKELUAR_Click()
Dim a As String
a = MsgBox("Yakin Mau Keluar ?", vbInformation + vbYesNo, "Data Buku")
    If a = vbYes Then End
End Sub
Sub BERSIH()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Text = ""
Next ctrl
End Sub
Sub AKTIF()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Enabled = True
Next ctrl
End Sub
Sub NONAKTIF()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Enabled = False
Next ctrl
End Sub
Sub SIMPAN()
Data1.Recordset!kdbuku = TKODE.Text
Data1.Recordset!judul = TJUDUL.Text
Data1.Recordset!author = TAUTHOR.Text
Data1.Recordset!jumlah = TJUMLAH.Text
Data1.Recordset.Update
End Sub
Sub TAMPIL()
TKODE.Text = Data1.Recordset!kdbuku
TJUDUL.Text = Data1.Recordset!judul
TAUTHOR.Text = Data1.Recordset!author
TJUMLAH.Text = Data1.Recordset!jumlah
End Sub
Private Sub CMDSIMPAN_Click()
On Error GoTo errsimpan
Data1.Recordset.AddNew
SIMPAN
NONAKTIF
BERSIH
CMDTAMBAH.SetFocus
Exit Sub
errsimpan:
MsgBox "Data Gagal Disimpan !", vbCritical + vbOKOnly, "Data Buku"
End Sub
Private Sub CMDTAMBAH_Click()
AKTIF
BERSIH
TKODE.SetFocus
End Sub
Private Sub CMDUBAH_Click()
On Error GoTo erredit
If CMDUBAH.Caption = "&UBAH" Then
    AKTIF
    TAMPIL
    CMDUBAH.Caption = "&UPDATE"
Else
    Data1.Recordset.Edit
    SIMPAN
    NONAKTIF
    BERSIH
    CMDUBAH.Caption = "&UBAH"
End If
Exit Sub
erredit:
MsgBox "Data Gagal Diedit !", vbCritical + vbOKOnly, "Data Buku"
End Sub
Private Sub Form_Load()
NONAKTIF
TKODE.MaxLength = 5
TJUDUL.MaxLength = 30
TAUTHOR.MaxLength = 20
TJUMLAH.MaxLength = 4
End Sub
TRANSAKSI
LISTING :
Private Sub CmdBatal_Click()
TxtNo.Enabled = False
TxtJudul.Enabled = False
TxtNama.Enabled = False
DTPicker2.Enabled = False
BERSIH
CmdTambah.SetFocus
End Sub
Private Sub CmdKeluar_Click()
Unload Me
End Sub
Private Sub CmdSimpan_Click()
If DBCombo1.Text = "" Or DBCombo2.Text = "" Then
    MsgBox "Lengkapi Dahulu !", vbCritical + vbOKOnly, "Perhatian"
Else
    With Data3.Recordset
    .AddNew
    .Fields(0) = TxtNo.Text
    .Fields(1) = DBCombo1.Text
    .Fields(2) = DBCombo2.Text
    .Fields(3) = DTPicker1.Value
    .Fields(4) = DTPicker2.Value
    .Update
    MsgBox "Data Berhasil Disimpab!", vbInformation + vbOKOnly, "Perhatian"
    End With
    CmdBatal_Click
End If
End Sub
Private Sub CmdTambah_Click()
AUTO
DBCombo1.SetFocus
End Sub
Private Sub DBCombo1_Change()
Data1.RecordSource = "select*from buku where kdbuku like '" & DBCombo1.Text & "'"
Data1.Refresh
    If Data1.Recordset.RecordCount <> 0 Then
        TxtJudul.Text = Data1.Recordset.Fields(1)
        Data1.RecordSource = "select*from buku"
        Data1.Refresh
    End If
End Sub
Private Sub DBCombo2_Change()
Data2.RecordSource = "select*from anggota where kdanggota like '" & DBCombo2.Text & "'"
Data2.Refresh
    If Data2.Recordset.RecordCount <> 0 Then
        TxtNama.Text = Data2.Recordset.Fields(1)
        Data2.RecordSource = "select*from anggota"
        Data2.Refresh
    End If
End Sub
Private Sub DTPicker1_Change()
DTPicker2.Value = Val(DTPicker1.Value) + 4
End Sub
Private Sub Form_Load()
TxtNo.Enabled = False
TxtJudul.Enabled = False
TxtNama.Enabled = False
DTPicker2.Enabled = False
End Sub
Sub AUTO()
Dim a As String
If Data3.Recordset.RecordCount > 0 Then
Data3.Recordset.MoveLast
a = Right(Data3.Recordset.Fields(0), 3) + 1
If a < 10 Then
TxtNo.Text = "T" & "-" & "00" & a
ElseIf a < 100 Then
TxtNo.Text = "T" & "-" & "0" & a
End If
Else
TxtNo.Text = "T" & "-" & "001"
End If
End Sub
Rub BERSIH()
TxtNo.Text = ""
DBCombo1.Text = "-Pilih-"
TxtJudul.Text = ""
DBCombo2.Text = "-Pilih-"
TxtNama.Text = ""
End Sub
LOGIN
LISTING :
Private Sub CmdBatal_Click()
End
End Sub
Private Sub CmdLogin_Click()
Data1.RecordSource = "select*from user where kduser like '" & TxtNama.Text & "'"
Data1.Refresh
    If Data1.Recordset.RecordCount <> 0 Then
        If TxtNama.Text = Data1.Recordset.Fields(0) _
            And TxtPassword.Text = Data1.Recordset.Fields(2) Then
                If Data1.Recordset.Fields(3) = "User" Then
                    MsgBox "Password Diterima ^_^", vbInformation + vbOKOnly, "Perhatian"
                    FrmMenuUtama.Show
                    FrmMenuUtama.Tb.Enabled = False
                    Unload Me
                Else
                    MsgBox "Password Diterima ^_^", vbInformation + vbOKOnly, "Perhatian"
                    FrmMenuUtama.Show
                    FrmMenuUtama.St.Panels(2) = Data1.Recordset.Fields(1)
                    FrmMenuUtama.St.Panels(3) = Data1.Recordset.Fields(3)
                    Unload Me
                End If
            End If
    Else
        MsgBox "User Tidak Ditemukan !", vbCritical + vbOKOnly, "Perhatian"
        TxtNama.Text = ""
        TxtPassword.Text = ""
        TxtNama.SetFocus
    End If
End Sub
Private Sub TxtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtPassword.SetFocus
End Sub
Private Sub TxtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then CmdLogin_Click
End Sub

MENU UTAMA
LISTING :
Private Sub Form_Load()
St.Panels(1).Text = "Perpustakaan Pintar ^_^"
End Sub
Private Sub LDA_Click()
LapAnggota.Show
End Sub
Private Sub LDB_Click()
LapBuku.Show
End Sub
Private Sub LDT_Click()
LapTransaksi.Show
End Sub
Private Sub Tb_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
    Case "buku"
    FrmBuku.Show vbModal
   
    Case "anggota"
    FrmAnggota.Show vbModal
   
    Case "transaksi"
    FrmTransaksi.Show vbModal
   
    Case "keluar"
    a = MsgBox("Yakin Mau Mengakhiri Program Perpustakaan ini ?", vbQuestion + vbOKCancel, "Perpustakaan")
        If a = vbOK Then End
   
End Select
End Sub
Private Sub Timer1_Timer()
St.Panels(4).Text = Date
St.Panels(5).Text = Time
End Sub
You might also like:


No comments:

Post a Comment

Kebahagiaan sejati bukanlah pada saat kita berhasil meraih apa yg kita perjuangkan, melainkan bagaimana kesuksesan kita itu memberi arti atau membahagiakan orang lain.