program aplikasi rental vcd vb 6

Aplikasi Rental VCD VB 6.0

Program rental VCD sebenarnya satu type dengan program Perpustakaan dimana prinsip dasarnya adalah adanya proses peminjaman dan pengembalian. Sisi perbedaannya hanya sedikit, yaitu (jika memang diperlukan) dalam program rental VCD tidak perlu adanya batasan peminjaman agar pemasukan dari penyewaan film semakin banyak.

Normalisasi File

Program Rental VCD ini dirancang dengan Normaliasi level ketiga (3NF) dengan bentuk seperti Gambar 10.1.

 

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

Tabel Pinjam

Pinjam
Nomorpjm	Tanggalpjm	Totalpjm	TotalHrg	Dibayar	Kembali	Nomoragt
07111401	14/11/07	3	6500	10000	3500	A001

Tabel DetailPjm

DetailPjm
Nomorpjm	NomorFlm	JumlahFlm
071114011	F001	1
071114012	F004	1
071114013	F007	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 Rental VCD, 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 RSFilm 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 RSFilm = 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 & "\ADOVCD.mdb"

End Sub

Transaksi Peminjaman Film

Dengan asumsi form login, data film, anggota telah dibuat, kini saatnya membuat form Rental VCD dengan bentuk seperti Gambar 10.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 kursor pindah ke grid transaksi peminjaman.

Coding :

Private Sub Form_Activate()

On Error Resume Next

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

    DT.RecordSource = "Transaksi"

    Set DG1.DataSource = DT

    DG1.Refresh

    Call BukaDB

    RSFilm.Open "Film", Conn

    List1.Clear

    Do Until RSFilm.EOF

        List1.AddItem RSFilm!Judul & Space(50) & RSFilm!Nomorflm

        RSFilm.MoveNext

    Loop

   

    Call AutoNomor

    LblTanggal.Caption = Date

    Call Tabel_Kosong

    DT.Recordset.MoveFirst

    DG1.Col = 1

End Sub

Private Sub Form_Load()

Call BukaDB

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 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

        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

    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

       

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

    DTCari.RecordSource = "select Film.Judul,detailpjm.JumlahFlm from Film,detailpjm,anggota where Film.NomorFlm=detailpjm.NomorFlm and nomoragt=' " & TxtNomorAgt & "'"

    DTCari.Refresh

    DG2.Refresh

    LbltelahPjm.Caption = DTCari.Recordset.RecordCount

   

    Call TelahPjm

   

    If TelahPjm = 0 Or LbltelahPjm = "" Then

        DG1.SetFocus

        DG1.Col = 1

    Else

        Call Pinjaman

        DG1.SetFocus

        DG1.Col = 1

        DG2.Visible = True

        Exit Sub

    End If

End If

End Sub

Function TelahPjm()

    On Error Resume Next

    Set TTLPjm = New adodb.Recordset

    TTLPjm.Open "SELECT sum(TOTALPJM) AS JUMTOTAL FROM PINJAM WHERE NOMORAGT='" & TxtNomorAgt & "'", Conn

    TelahPjm = TTLPjm!JumTotal

    LbltelahPjm.Caption = TelahPjm

End Function

Sub Pinjaman()

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

    DTCari.RecordSource = "Select Distinct Detailpjm.Nomorpjm,Film.Nomorflm,Judul,Jumlahflm From Anggota,Pinjam,Film,Detailpjm Where Film.Nomorflm=Detailpjm.Nomorflm And Pinjam.Nomorpjm=Left(Detailpjm.Nomorpjm,8) And Anggota.Nomoragt=Pinjam.Nomoragt And Anggota.Nomoragt='" & TxtNomorAgt & "'"

    DTCari.Refresh

    LbltelahPjm.Caption = DTCari.Recordset.RecordCount

End Sub

Private Sub DG1_AfterColEdit(ByVal ColIndex As Integer)

If DG1.Col = 1 Then

    Call BukaDB

    RSFilm.Open "Select * from Film where NomorFlm='" & DT.Recordset!Kode & "'", Conn

    If RSFilm.EOF Then

        Pesan = MsgBox("Kode Flm Tidak Terdaftar")

        DG1.Col = 1

        Exit Sub

    End If

    DT.Recordset!Kode = RSFilm!Nomorflm

    DT.Recordset!Judul = RSFilm!Judul

    DT.Recordset!Jumlah = 1

    DT.Recordset!tarif = RSFilm!tarif

    Call Tambah_Baris

    DT.Recordset.MoveNext

    DG1.Col = 1

    DT.Recordset.MoveLast

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

End If

If DG1.Col = 3 Then

    DT.Recordset!Jumlah = DT.Recordset!Jumlah

    DT.Recordset.Update

    DT.Recordset.MoveNext

    DG1.Col = 1

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

    LblTotalHrg.Caption = Format(TotalHrg, "#,###,###")

End If

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

Private Sub TxtDibayar_KeyPress(Keyascii As Integer)

    If Keyascii = 13 Then

        If TxtDibayar = "" Or Val(TxtDibayar) < (LblTotalHrg) Then

            MsgBox "Jumlah Pembayaran Kurang"

            TxtDibayar.SetFocus

        Else

            TxtDibayar = Format(TxtDibayar, "###,###,###")

            If TxtDibayar = LblTotalHrg Then

                LblKembali = TxtDibayar - LblTotalHrg

            Else

                LblKembali = Format(TxtDibayar - LblTotalHrg, "###,###,###")

            End If

        CmdSimpan.Enabled = True

        CmdSimpan.SetFocus

        End If

    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 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,TotalHrg,Dibayar,Kembali,Nomoragt)" & _

"values('" & LblNomorPjm.Caption & "','" & LblTanggal.Caption & "','" & LblTotalPjm.Caption & "','" & LblTotalHrg.Caption & "','" & TxtDibayar & "','" & LblKembali.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,NomorFlm,JumlahFlm) " & _

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

        Conn.Execute (SQLInput2)

    End If

DT.Recordset.MoveNext

Loop

   

'Pengurangan Jumlah Flm

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

    If DT.Recordset!Kode <> vbNullString Then

        Call BukaDB

        RSFilm.Open "Select * from Film where NomorFlm='" & DT.Recordset!Kode & "'", Conn

        If Not RSFilm.EOF Then

            Dim kurangi As String

            kurangi = "update Film set stok='" & RSFilm!Stok - DT.Recordset!Jumlah & "' where NomorFlm='" & DT.Recordset!Kode & "'"

            Conn.Execute (kurangi)

        End If

    End If

DT.Recordset.MoveNext

Loop

Call Bersihkan

Form_Activate

cmdbatal_Click

End Sub

Sub Bersihkan()

TxtNomorAgt = ""

LblNamaAgt.Caption = ""

LblTotalPjm.Caption = ""

LbltelahPjm.Caption = ""

LblTotalHrg.Caption = ""

TxtDibayar = ""

LblKembali.Caption = ""

End Sub

Function TotalPjm()

    Set TTLPjm = New adodb.Recordset

    TTLPjm.Open "select sum(Jumlah) as JumTotal from Transaksi", Conn

    TotalPjm = TTLPjm!JumTotal

End Function

Function TotalHrg()

    Set TTLHrg = New adodb.Recordset

    TTLHrg.Open "select sum(Tarif) as JumTotal from Transaksi", Conn

    TotalHrg = TTLHrg!JumTotal

End Function

Private Sub cmdbatal_Click()

On Error Resume Next

Form_Activate

TxtNomorAgt = ""

LblNamaAgt = ""

LblTotalPjm = ""

LbltelahPjm = ""

Call Pinjaman

TxtNomorAgt.SetFocus

End Sub

Private Sub cmdtutup_Click()

Unload Me

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

            RSFilm.Open "Select * from Film where nomorflm ='" & Right(List1, 4) & "'", Conn

            RSFilm.Requery

            If Not RSFilm.EOF Then

                DT.Recordset!Kode = RSFilm!Nomorflm

                DT.Recordset!Judul = RSFilm!Judul

                DT.Recordset!Jumlah = 1

                DT.Recordset!tarif = RSFilm!tarif

                Call Tambah_Baris

                DT.Recordset.MoveNext

                DG1.Col = 1

                DT.Recordset.MoveLast

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

                LblTotalHrg.Caption = Format(TotalHrg, "#,###,###")

            End If

        End If

    End If

End Sub

Transaksi Pengembalian Film

Transaksi pengembalian film ini dilakukan dengan cara mengetik nomor anggota kemudian memilih data film yang akan dikembalikan di DataGrid2, setelah itu pehatikanlah jumlah dendanya, jika ada denda yang harus dibayar maka isilah jumlah pembayaran dendanya. Aturan dalam denda dapat Anda tentukan sendiri. Dalam program ini maksimal lama pinjam adalah 5 hari dengan denda Rp. 500,- per hari per film.

Coding :

Private Sub Form_Activate()

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

    DT.RecordSource = "Transaksi1"

    Set DG1.DataSource = DT

    DG1.Refresh

    Call AutoNomor

    LblTanggalKbl.Caption = Date

    Call Tabel_Kosong

    DT.Recordset.MoveFirst

    DG1.Col = 1

End Sub

Private Sub Form_Load()

Call BukaDB

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 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

        End If

        LblNomorKbl = Urutan

    End With

End Sub

Private Sub LblDenda_Change()

If Val(LblDenda) = 0 Then

    TxtDibayar.Enabled = False

    TxtDibayar = 0

    LblKembali = 0

ElseIf LblDenda = "" Then

    TxtDibayar = ""

    TxtDibayar.Enabled = True

    LblKembali = ""

ElseIf LblDenda > 0 Then

    TxtDibayar = ""

    TxtDibayar.Enabled = True

End If

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

    LbltelahPjm = ""

    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 CariPinjaman

     

    If LbltelahPjm = "" Or LbltelahPjm = 0 Then

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

        Me.Height = 4455

        TxtNomorAgt.SetFocus

        Exit Sub

    End If

End If

End Sub

Sub CariPinjaman()

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

DTCari.RecordSource = "Select Distinct Detailpjm.Nomorpjm As [No Pjm],Film.Nomorflm As [No Film],Judul,Tanggalpjm As [Tgl Pjm], (Tanggalpjm+4) As [Hrs Kbl],Jumlahflm As [Jml Flm], (Date()-Tanggalpjm)+1 As [Lama Pjm] From Anggota,Pinjam,Film,Detailpjm Where Film.Nomorflm=Detailpjm.Nomorflm 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 = "" Or Val(TxtDibayar) < (LblDenda) Then

            MsgBox "Jumlah Pembayaran Kurang"

            TxtDibayar.SetFocus

        Else

            TxtDibayar = Format(TxtDibayar, "###,###,###")

            If TxtDibayar = LblDenda Then

                LblKembali = TxtDibayar - LblDenda

            Else

                LblKembali = Format(TxtDibayar - LblDenda, "###,###,###")

            End If

        CmdSimpan.Enabled = True

        CmdSimpan.SetFocus

        End If

    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,NomorFlm,JumlahFlm) " & _

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

        Conn.Execute (SQLInput2)

    End If

DT.Recordset.MoveNext

Loop

   

'penambahan Jumlah Film

DT.Recordset.MoveFirst

Do While Not DT.Recordset.EOF

    If DT.Recordset!NomorPjm <> vbNullString Then

        Call BukaDB

        RSFilm.Open "Select * from Film where NomorFlm='" & DT.Recordset!Nomorflm & "'", Conn

        If Not RSFilm.EOF Then

            Dim Tambah As String

            Tambah = "update Film set stok='" & RSFilm!Stok + DT.Recordset!Jumlah & "' where nomorFlm='" & DT.Recordset!Nomorflm & "'"

            Conn.Execute (Tambah)

        End If

    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

    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

   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 = ""

End Sub

Private Sub cmdbatal_Click()

Form_Activate

Call Bersihkan

Call CariPinjaman

LbltelahPjm = ""

TxtNomorAgt.SetFocus

End Sub

Private Sub cmdtutup_Click()

Unload Me

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

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

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

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

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

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

    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 = TotalKbl

    LblDenda = Str(JmlDenda)

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 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

Catatan :

Dalam CD pendukung kami telah melengkapi program rental VCD ini dengan beberapa laporan dan rincian masing-masing transaksi, baik peminjaman maupun pengembalian.