Blog Tutorial VB.Net: program aplikasi perpustakaan vb 6

Aplikasi Perpustakaan VB 6.0

Normalisasi File

Program Perpustakaan ini dirancang dengan Normaliasi level ketiga (3NF) dengan bentuk seperti Gambar 9.1.

Program perpustakaan ini menyimpan data ke dua tabel yaitu tabel Pinjam dan DetailPjm seperti terlihat pada tabel-tabel berikut ini.

Tabel Pinjam

Pinjam
Nomorpjm	Tanggalpjm	Totalpjm	Nomoragt
07091401	14/09/07	3	A001

Tabel DetailPjm

DetailPjm
Nomorpjm	Nomorbk	Jumlahbk
070914011	B001	1
070914012	B002	1
070914013	B003	1

Database Dan Tabel

Untuk mengetahui file database dan struktur masing-masing tabel berikut type data dan kunci primer maupun kunci tamunya silakan buka CD pendukung buku ini.

Membuat Module

Untuk memulai membuat program Perpustakaan, aktifkanlah VB kemudian awali dengan membuat module lalu ketik coding berikut ini.

Coding :

Public Conn As New adodb.Connection

Public RSAnggota As adodb.Recordset

Public RSBuku As adodb.Recordset

Public RSPinjam As adodb.Recordset

Public RSDetailPjm As adodb.Recordset

Public RSKembali As adodb.Recordset

Public RSDetailKbl As adodb.Recordset

Public RSTansPjm As adodb.Recordset

Public RSTansKbl As adodb.Recordset

Public Sub BukaDB()

Set Conn = New adodb.Connection

Set RSAnggota = New adodb.Recordset

Set RSBuku = New adodb.Recordset

Set RSPinjam = New adodb.Recordset

Set RSDetailPjm = New adodb.Recordset

Set RSKembali = New adodb.Recordset

Set RSDetailKbl = New adodb.Recordset

Set RSTansPjm = New adodb.Recordset

Set RSTansKbl = New adodb.Recordset

Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ADOPustaka.mdb"

End Sub

Transaksi Peminjaman Buku

Dengan asumsi form login, data buku, anggota telah dibuat, kini saatnya membuat form Peminjaman dengan bentuk seperti Gambar 9.3 berikut ini.

Ilustrasi pada program ini adalah sebagai berikut:

1. Nomor pinjam dan tanggal muncul secara otomatis, berubah setiap hari dan setiap ganti transaksi (disarankan untuk mengecek kembali validasi tanggal dengan format dd/mm/yy sebelum program dijalankan).

2. Hal pertama yang harus dilakukan adalah mengetik Nomor Anggota. Jika ditemukan maka akan tampil namanya, jika pernah meminjam maka jumlahnya akan ditampilkan di DataGrid bagian bawah, jika belum pernah pinjam maka akan muncul keterangan dan diperbolehkan meminjam 4 buku.

3. Jika jumlah telah pinjam dan jumlah peminjaman sekarang >=4 maka akan muncul pesan bahwa peminjaman sudah maksimal. Jika jumlah total peminjaman belum mencapai 4 maka peminjaman boleh dilanjutkan. Jumlah pinjam tiap buku adalah satu buah.

Coding :

Private Sub Form_Activate()

'hubungkan objek adodc ke database

DT.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOPustaka.mdb"

'hubungkan objek adodc ke tabel

DT.RecordSource = "Transaksi"

'sumber data untuk grid1 adalah data dalam objek

Set DG1.DataSource = DT

'grid di-refresh

DG1.Refresh

'panggil file database

Call BukaDB

'buka tabel buku dan tampilkan kode dan judlnya di list sebelah kanan

RSBuku.Open "Buku", Conn

List1.Clear

Do Until RSBuku.EOF

List1.AddItem RSBuku!Judul & Space(50) & RSBuku!NomorBk

RSBuku.MoveNext

Loop

'tampilkan nomor pinjam otomatis

Call AutoNomor

LblTanggal.Caption = Date

Call Tabel_Kosong

DT.Recordset.MoveFirst

DG1.Col = 1

End Sub

'cari nomor pinjaman terakhir

Private Sub AutoNomor()

Call BukaDB

RSPinjam.Open "select * from Pinjam Where NomorPjm In(Select Max(NomorPjm)From Pinjam)Order By NomorPjm Desc", Conn

RSPinjam.Requery

Dim Urutan As String * 8

Dim Hitung As Long

With RSPinjam

If .EOF Then

Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "01"

LblNomorPjm = Urutan

Else

If Left(!NomorPjm, 6) <> Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) Then

Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "01"

Else

Hitung = (!NomorPjm) + 1

Urutan = (Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2)) + Right("00" & Hitung, 2)

End If

LblNomorPjm = Urutan

End With

End Sub

Private Sub TxtNomorAgt_KeyPress(Keyascii As Integer)

TxtNomorAgt.MaxLength = 4

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 27 Then Unload Me

If Keyascii = 13 Then

Call BukaDB

'cari nomor anggota yang diketik

RSAnggota.Open "Select * from anggota where nomoragt='" & TxtNomorAgt & "'", Conn

'jika ditemukan

If Not RSAnggota.EOF Then

'tampilkan namanya

LblNamaAgt.Caption = RSAnggota!Namaagt

DG1.SetFocus

DG1.Col = 1

Else

'jika tidak ditemukan, munculkan pesan

MsgBox "Nomor anggota tidak terdaftar"

TxtNomorAgt.SetFocus

Exit Sub

End If

Call Pinjaman

'batas-batas peminjaman

If LbltelahPjm = 0 Or LbltelahPjm = "" Then

Pesan = MsgBox(" " & LblNamaAgt & " Silahkan Pinjam Maksimal " & 4 & " Buku", 0, "Informasi Peminjaman Buku")

DG1.SetFocus

DG1.Col = 1

ElseIf LbltelahPjm = 1 Then

Pesan = MsgBox(" " & LblNamaAgt & " Boleh Meminjam " & 3 & " Buku Lagi", 0, "Informasi Peminjaman Buku")

DG1.SetFocus

DG1.Col = 1

Exit Sub

ElseIf LbltelahPjm = 2 Then

Pesan = MsgBox(" " & LblNamaAgt & " Boleh Meminjam " & 2 & " Buku Lagi", 0, "Informasi Peminjaman Buku")

DG1.SetFocus

DG1.Col = 1

Exit Sub

ElseIf LbltelahPjm = 3 Then

Pesan = MsgBox(" " & LblNamaAgt & " Boleh Meminjam " & 1 & " Buku Lagi", 0, "Informasi Peminjaman Buku")

DG1.SetFocus

DG1.Col = 1

Exit Sub

ElseIf LbltelahPjm >= 4 Then

Pesan = MsgBox(" " & LblNamaAgt & " Tidak Boleh Meminjam Lagi...!", 0, "Informasi Peminjaman")

LbltelahPjm = ""

LblNamaAgt = ""

TxtNomorAgt.SetFocus

Exit Sub

End If

End Sub

Sub Pinjaman()

DTCari.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOPustaka.mdb"

DTCari.RecordSource = "Select Buku.Nomorbk,Judul,Jumlahbk From Anggota,Pinjam,Buku,Detailpjm Where Buku.Nomorbk=Detailpjm.Nomorbk And Pinjam.Nomorpjm=Left(Detailpjm.Nomorpjm,8) And Anggota.Nomoragt=Pinjam.Nomoragt And Anggota.Nomoragt='" & TxtNomorAgt & "'"

DTCari.Refresh

DG2.Refresh

LbltelahPjm.Caption = DTCari.Recordset.RecordCount

End Sub

'transaksi peminjaman dlam grid1

Private Sub DG1_AfterColEdit(ByVal ColIndex As Integer)

If DG1.Col = 1 Then

Call BukaDB

'cari kode buku

RSBuku.Open "Select * from Buku where NomorBK='" & DT.Recordset!Kode & "'", Conn

'jika tidak ditemukan, munculkan pesan

If RSBuku.EOF Then

Pesan = MsgBox("Kode Buku Tidak Terdaftar")

DG1.Col = 1

Exit Sub

End If

'jika ditemukan, tampilkan nomor dan judul buku

DT.Recordset!Kode = RSBuku!NomorBk

DT.Recordset!Judul = RSBuku!Judul

'jumlah pinjam asumsinya 1 buku

DT.Recordset!Jumlah = 1

'pindah ke baris berikutnya

Call Tambah_Baris

DT.Recordset.MoveNext

DG1.Col = 1

DT.Recordset.MoveLast

'tampilkan jumlah total pinjaman

LblTotalPjm.Caption = DT.Recordset.RecordCount - 1

End If

If DG1.Col = 3 Then

DT.Recordset!Jumlah = DT.Recordset!Jumlah

DT.Recordset.Update

DT.Recordset.MoveNext

DG1.Refresh

DG1.Col = 1

LblTotalPjm.Caption = DT.Recordset.RecordCount - 1

End If

If Val(LbltelahPjm) + Val(LblTotalPjm) = 4 Then

MsgBox "pinjaman sudah masimal"

DG1.AllowAddNew = False

DG1.AllowUpdate = False

CmdSimpan.SetFocus

Exit Sub

'jika jumlah telah pinjam dan pinjaman sekarang lebih dari 4,

'munculkan pesan bahwa pinjaman telah maksimal

ElseIf Val(LbltelahPjm) + Val(LblTotalPjm) > 4 Then

MsgBox "pinjaman melebihi batas, edit jumlah pinjaman"

DG1.SetFocus

CmdSimpan.SetFocus

Exit Sub

End If

End Sub

Private Sub cmdSimpan_Click()

'jika total pinjaman belum ada, tampilkan pesan

If LblTotalPjm.Caption = "" Then

MsgBox "Tidak ada transaksi peminjaman"

TxtNomorAgt.SetFocus

Exit Sub

End If

'simpan ke tabel pinjam

Dim SQLInput1 As String

SQLInput1 = "Insert Into Pinjam(Nomorpjm,TanggalPjm,TotalPjm,Nomoragt)" & _

"values('" & LblNomorPjm.Caption & "','" & LblTanggal.Caption & "','" & LblTotalPjm.Caption & "','" & TxtNomorAgt & "')"

Conn.Execute (SQLInput1)

'simpan ke tabel detailpjm

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!Kode <> vbNullString Then

Dim SQLInput2 As String

SQLInput2 = "Insert Into DetailPjm(Nomorpjm,Nomorbk,Jumlahbk) " & _

"values ('" & LblNomorPjm.Caption + DT.Recordset!Nomor & "','" & DT.Recordset!Kode & "','" & DT.Recordset!Jumlah & "')"

Conn.Execute (SQLInput2)

End If

DT.Recordset.MoveNext

Loop

'Pengurangan Jumlah buku

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!Kode <> vbNullString Then

Call BukaDB

RSBuku.Open "Select * from Buku where Nomorbk='" & DT.Recordset!Kode & "'", Conn

If Not RSBuku.EOF Then

Dim kurangi As String

kurangi = "update buku set stok='" & RSBuku!Stok - DT.Recordset!Jumlah & "' where nomorbk='" & DT.Recordset!Kode & "'"

Conn.Execute (kurangi)

End If

DT.Recordset.MoveNext

Loop

Bersihkan

Form_Activate

cmdbatal_Click

End Sub

Sub Bersihkan()

TxtNomorAgt = ""

LblNamaAgt.Caption = ""

LblTotalPjm.Caption = ""

LbltelahPjm.Caption = ""

End Sub

Function Tabel_Kosong()

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

DT.Recordset.Delete

DT.Recordset.MoveNext

Loop

For i = 1 To 1

DT.Recordset.AddNew

DT.Recordset!Nomor = i

DT.Recordset.Update

Next i

End Function

Private Sub cmdbatal_Click()

Form_Activate

TxtNomorAgt = ""

LblNamaAgt = ""

LblTotalPjm = ""

LbltelahPjm = ""

DG1.Enabled = True

Call Pinjaman

TxtNomorAgt.SetFocus

End Sub

Private Sub cmdtutup_Click()

Unload Me

End Sub

Function Tambah_Baris()

For i = DT.Recordset.RecordCount To DT.Recordset.RecordCount

DT.Recordset.AddNew

DT.Recordset!Nomor = i + 1

DT.Recordset.Update

Next i

End Function

Function Kurangi_Baris()

For i = DT.Recordset.RecordCount To DT.Recordset.RecordCount

DT.Recordset.Delete

DT.Recordset.Update

Next i

End Function

'jika menekan ESC dalam grid transaksi

'data akan hilang (dibatalkan) dan baris berkurang

Private Sub DG1_Keypress(Keyascii As Integer)

On Error GoTo salah

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 27 Then

DT.Recordset!Kode = Null

DT.Recordset!Judul = Null

DT.Recordset!Jumlah = Null

DT.Recordset.Update

Call Kurangi_Baris

LblTotalPjm.Caption = DT.Recordset.RecordCount - 1

End If

On Error GoTo 0

Exit Sub

salah:

cmdbatal_Click

End Sub

Private Sub List1_keyPress(Keyascii As Integer)

If Keyascii = 13 Then

If DG1.SelText <> Right(List1, 4) Then

DG1.SelText = Right(List1, 4)

DT.Recordset.Update

Call BukaDB

RSBuku.Open "Select * from Buku where nomorBk ='" & Right(List1, 4) & "'", Conn

RSBuku.Requery

If Not RSBuku.EOF Then

DT.Recordset!Kode = RSBuku!NomorBk

DT.Recordset!Judul = RSBuku!Judul

DT.Recordset!Jumlah = 1

Call Tambah_Baris

DT.Recordset.MoveNext

DG1.Col = 1

DT.Recordset.MoveLast

'LblTotalPjm.Caption = Format(TotalPjm, "##")

LblTotalPjm.Caption = DT.Recordset.RecordCount - 1

If Val(LbltelahPjm) + Val(LblTotalPjm) = 4 Then

MsgBox "Pinjaman Sudah Maksimal"

DG1.AllowAddNew = False

DG1.AllowUpdate = False

CmdSimpan.SetFocus

Exit Sub

'jika jumlah telah pinjam dan pinjaman sekarang lebih dari 4,

'munculkan pesan bahwa pinjaman telah maksimal

ElseIf Val(LbltelahPjm) + Val(LblTotalPjm) > 4 Then

MsgBox "Pinjaman melebihi batas, edit jumlah pinjaman"

DG1.SetFocus

CmdSimpan.SetFocus

Exit Sub

End If

End Sub

Transaksi Pengembalian Buku

Ilustrasi dalam program pengembalian ini adalah sebagai berikut:

1. Nomor pengembalian muncul otomatis berikut tanggal kembalinya.

2. Setelah mengetik nomor anggota, jika ditemukan maka akan muncul nama anggota.

3. Jika nomor anggota tersebut pernah meminjam maka akan ditampilkan datanya pada DataGrid bagian bawah.

4. Untuk mengembalikan buku cukup dengan memilih data dalam Grid bagian bawah lalu menekan enter.

5. Pada saat disimpan maka data yang berubah terjadi pada lima tabel yaitu :

a. Di tabel pinjaman jumlah total pinjam akan berkurang sebanyak buku yang dikembalikan.

b. Di tabel detailpjm data akan hilang berdasarkan nomor pinjamnya karena buku dikembalikan.

c. Di tabel kembali jumlah total kembali akan bertambah sebanyak buku yang dikembalikan. Perubahan juga terjadi pada kolom denda jika tanggal pengembalian melebihi batas akhir peminjaman. Denda per hari Rp. 500 per buku.

d. Di tabel detailkbl data akan bertambah sebanyak buku yang dikembalikan.

e. Di tabel buku, jumlah stok buku akan bertambah sebanyak buku yang dikembalikan.

Coding :

Private Sub Form_Activate()

DT.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOPustaka.mdb"

DT.RecordSource = "Transaksi1"

Set DG1.DataSource = DT

DG1.Refresh

Call AutoNomor

LblTanggalKbl.Caption = Date

Call Tabel_Kosong

DT.Recordset.MoveFirst

DG1.Col = 1

LblDenda = 0

LblKembali = 0

TxtDibayar = 0

CmdSimpan.Enabled = False

End Sub

Private Sub Form_Load()

Call BukaDB

End Sub

Private Sub AutoNomor()

Call BukaDB

RSKembali.Open "select * from kembali Where NomorKbl In(Select Max(NomorKbl)From Kembali)Order By NomorKbl Desc", Conn

RSKembali.Requery

Dim Urutan As String * 8

Dim Hitung As Long

With RSKembali

If .EOF Then

Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "01"

LblNomorKbl = Urutan

Else

If Left(!NomorKbl, 6) <> Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) Then

Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "01"

Else

Hitung = (!NomorKbl) + 1

Urutan = (Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2)) + Right("00" & Hitung, 2)

End If

LblNomorKbl = Urutan

End With

End Sub

Private Sub TxtNomorAgt_KeyPress(Keyascii As Integer)

On Error Resume Next

TxtNomorAgt.MaxLength = 4

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 27 Then Unload Me

If Keyascii = 13 Then

Call BukaDB

RSAnggota.Open "Select * from anggota where nomoragt='" & TxtNomorAgt & "'", Conn

If Not RSAnggota.EOF Then

LblNamaAgt.Caption = RSAnggota!Namaagt

DG1.SetFocus

DG1.Col = 1

Else

MsgBox "Nomor anggota tidak terdaftar"

TxtNomorAgt.SetFocus

Exit Sub

End If

Call Pinjaman

If LbltelahPjm = "" Or LbltelahPjm = 0 Then

MsgBox "'" & LblNamaAgt & "' tidak punya pinjaman"

TxtNomorAgt.SetFocus

Exit Sub

End If

End Sub

Sub Pinjaman()

DTCari.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOPustaka.mdb"

DTCari.RecordSource = "Select Distinct Detailpjm.Nomorpjm,Buku.Nomorbk,Judul,Tanggalpjm, (Tanggalpjm+4) As Harus_Kembali,Jumlahbk, (Date()-Tanggalpjm)+1 As Lmpinjam_Hari From Anggota,Pinjam,Buku,Detailpjm Where Buku.Nomorbk=Detailpjm.Nomorbk And Pinjam.Nomorpjm=Left(Detailpjm.Nomorpjm,8) And Anggota.Nomoragt=Pinjam.Nomoragt And Anggota.Nomoragt='" & TxtNomorAgt & "'"

DTCari.Refresh

DG2.Refresh

LbltelahPjm.Caption = DTCari.Recordset.RecordCount

End Sub

Private Sub TxtDibayar_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If TxtDibayar = "" And LblDenda <> 0 Then

MsgBox "jumlah pembayaran kosong"

TxtDibayar.SetFocus

Exit Sub

ElseIf Val(TxtDibayar) = LblDenda Then

LblKembali = 0

CmdSimpan.Enabled = True

CmdSimpan.SetFocus

Exit Sub

ElseIf Val(TxtDibayar) < LblDenda Then

MsgBox "jumlah pembayaran kurang"

TxtDibayar.SetFocus

Exit Sub

ElseIf Val(TxtDibayar) > LblDenda Then

LblKembali = Val(TxtDibayar) - LblDenda

CmdSimpan.Enabled = True

CmdSimpan.SetFocus

ElseIf TxtDibayar = "" And LblDenda = 0 Then

LblKembali = 0

CmdSimpan.Enabled = True

CmdSimpan.SetFocus

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

Private Sub CmdSimpan_Keypress(Keyascii As Integer)

If Keyascii = 27 Then

CmdSimpan.Enabled = False

TxtDibayar = ""

TxtDibayar.SetFocus

End If

End Sub

Private Sub cmdSimpan_Click()

If LblTotalKbl.Caption = "" Then

MsgBox "Tidak ada transaksi pengembalian"

TxtNomorAgt.SetFocus

Exit Sub

End If

'simpan ke tabel kembali

Dim SQLInput1 As String

SQLInput1 = "Insert Into kembali(Nomorkbl,Tanggalkbl,Totalkbl,Nomoragt,denda,Dibayar,kembali)" & _

"values('" & LblNomorKbl & "','" & LblTanggalKbl & "','" & LblTotalKbl & "','" & TxtNomorAgt & "','" & LblDenda & "','" & TxtDibayar & "','" & LblKembali & "')"

Conn.Execute (SQLInput1)

'simpan ke tabel detailkbl

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!NomorPjm <> vbNullString Then

Dim SQLInput2 As String

SQLInput2 = "Insert Into Detailkbl(Nomorkbl,Nomorbk,Jumlahbk) " & _

"values ('" & LblNomorKbl + DT.Recordset!Nomor & "','" & DT.Recordset!NomorBk & "','" & DT.Recordset!Jumlah & "')"

Conn.Execute (SQLInput2)

End If

DT.Recordset.MoveNext

Loop

'penambahan Jumlah buku

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!NomorPjm <> vbNullString Then

Call BukaDB

RSBuku.Open "Select * from Buku where Nomorbk='" & DT.Recordset!NomorBk & "'", Conn

If Not RSBuku.EOF Then

Dim Tambah As String

Tambah = "update buku set stok='" & RSBuku!Stok + DT.Recordset!Jumlah & "' where nomorbk='" & DT.Recordset!NomorBk & "'"

Conn.Execute (Tambah)

End If

DT.Recordset.MoveNext

Loop

'hapus pinjaman

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!NomorPjm <> vbNullString Then

Call BukaDB

RSDetailPjm.Open "Select * from detailpjm where nomorpjm='" & DT.Recordset!NomorPjm & "'", Conn

If Not RSDetailPjm.EOF Then

Dim hapus As String

hapus = "delete from detailpjm where nomorpjm ='" & DT.Recordset!NomorPjm & "'"

Conn.Execute (hapus)

End If

DT.Recordset.MoveNext

Loop

'kurangi pinjaman

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

If DT.Recordset!NomorPjm <> vbNullString Then

Call BukaDB

RSPinjam.Open "Select * from pinjam where nomorpjm='" & Left(DT.Recordset!NomorPjm, 8) & "'", Conn

If Not RSPinjam.EOF Then

Dim kurangi As String

kurangi = "update pinjam set totalpjm= '" & RSPinjam!TotalPjm - DT.Recordset!Jumlah & " ' where nomorpjm='" & Left(DT.Recordset!NomorPjm, 8) & "' and nomoragt='" & TxtNomorAgt & "'"

Conn.Execute (kurangi)

End If

DT.Recordset.MoveNext

Loop

Bersihkan

Form_Activate

cmdbatal_Click

End Sub

Sub Bersihkan()

TxtNomorAgt = ""

LblNamaAgt.Caption = ""

LblTotalKbl.Caption = ""

LbltelahPjm.Caption = ""

LblDenda = ""

TxtDibayar = ""

LblKembali.Caption = ""

End Sub

Function Tabel_Kosong()

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

DT.Recordset.Delete

DT.Recordset.MoveNext

Loop

For i = 1 To 1

DT.Recordset.AddNew

DT.Recordset!Nomor = i

DT.Recordset.Update

Next i

End Function

Function TotalKbl()

Set TTlkbl = New adodb.Recordset

TTlkbl.Open "select sum(Jumlah) as JumTotal from Transaksi1", Conn

TotalKbl = TTlkbl!JumTotal

End Function

Function JmlDenda()

Set RSDenda = New adodb.Recordset

RSDenda.Open "Select sum(Denda) as TDenda from Transaksi1 where denda>=0", Conn

JmlDenda = RSDenda!TDenda

End Function

Private Sub cmdbatal_Click()

Call Bersihkan

Call Pinjaman

TxtNomorAgt.SetFocus

Form_Activate

End Sub

Private Sub cmdtutup_Click()

Unload Me

End Sub

Function Tambah_Baris()

For i = DT.Recordset.RecordCount To DT.Recordset.RecordCount

DT.Recordset.AddNew

DT.Recordset!Nomor = i + 1

DT.Recordset.Update

Next i

End Function

Function Kurangi_Baris()

For i = DT.Recordset.RecordCount To DT.Recordset.RecordCount

DT.Recordset.Delete

DT.Recordset.Update

Next i

End Function

Private Sub DG1_Keypress(Keyascii As Integer)

On Error Resume Next

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 27 Then

DT.Recordset!NomorPjm = Null

DT.Recordset!NomorBk = Null

DT.Recordset!Judul = Null

DT.Recordset!Tanggal = Null

DT.Recordset!Jumlah = Null

DT.Recordset.Update

LblTotalKbl = Format(TotalKbl, "#,###,###")

Call Kurangi_Baris

End If

End Sub

Private Sub DG2_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyReturn

Call SelectAllVisible

End Select

End Sub

Sub SelectAllVisible()

On Error Resume Next

'pengembalian buku dicari berdasarkan nomor pinjam di grid2

'cukup dengan cara memilih baris kemudian menekan enter

DT.Recordset!NomorPjm = DG2.Columns(0)

DT.Recordset!NomorBk = DG2.Columns(1)

DT.Recordset!Judul = DG2.Columns(2)

DT.Recordset!Tanggal = DG2.Columns(3)

DT.Recordset!Jumlah = DG2.Columns(5)

'jika lama pinjam lebih dari 5 hari

'maka hari keenam dikenakan denda

'sebesar 500 / hari (harga denda per hari dapat diubah)

If CDate(DT.Recordset!Tanggal) + 5 > 5 Then

DT.Recordset!Denda = (CDate(LblTanggalKbl) - (DT.Recordset!Tanggal) - 4) * 500 * DT.Recordset!Jumlah

End If

If DT.Recordset!Denda <= 0 Then

DT.Recordset!Denda = 0

End If

Call Tambah_Baris

DT.Recordset.MoveNext

DG1.Col = 1

DT.Recordset.MoveLast

LblTotalKbl = Format(TotalKbl, "#,###,###")

LblDenda = Str(JmlDenda)

End Sub

Pembuatan Laporan

Disini kami tidak lagi menjelaskan tentang pembuatan laporan untuk tabel master (tabel Buku, Anggota) tapi kami akan langsung menggambarkan peminjaman harian, mingguan dan bulanan dimana laporan tersebut prototypenya digunakan juga untuk laporan pengembalian buku.