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
1 komentar:
tolong dong mas,klau copas di sebutkan sourcenya..kita kan sesama blogger..saling respect dong
http://qqbrekele.blogspot.com/2012/01/contoh-listing-vb-60-program-peminjaman.html
Posting Komentar