Visual Basic v. 6

Database Diagram

The application uses MS Access as its backend database. The database contains the following three tables.

Car List

Primary Key

Field Name

Maker

Make

Year Model

Price Per Day

Currency

Plate Number

Primary Key

Field Name

Contact Number

Car Category

Plate Number

Price Per Day

Currency

Number of Days Rented

Continuation of Customer List Table

Primary Key

Field Name

Currency

Final Charge

Currency

Users List

Primary Key

Field Name

Username

Password

Forms

The application has 5 operations from the main form. This includes Login, Car Data Input, Customer Data Input, Car Charge Calculation, and Quit. Following are the design of each of these forms.

Login Form

Main Form

Car Data Input Form

Customer Data Input Form

Car Charge Calculator

Printout of Code

frmMain

Option Explicit

Private Sub-cmdCarInput_Click ()

frmCarInput.Show

End Sub

Private Sub-cmdChrgCalc_Click ()

frmChrgCalc.Show

End Sub

Private Sub-cmdCustInput_Click ()

frmCustInput.Show

End Sub

Private Sub-cmdOpenLogin_Click ()

frmLogin.Show

End Sub

Private Sub-cmdQuit_Click ()

End

End Sub

frmLogin

Option Explicit

Dim adoCon_MDB As New ADODB.Connection

Dim adoRS_MDB As New ADODB.Recordset

Private Sub-cmdLogin_Click ()

Dim recFound As Boolean

adoRS_MDB.Source = "SELECT * FROM [Users List]"

adoRS_MDB.Source = adoRS_MDB.Source & " WHERE Username = '" & txtUserNm & ""

adoRS_MDB.CursorType = adOpenDynamic

adoRS_MDB.ActiveConnection = adoCon_MDB

adoRS_MDB.Open

recFound = False

If adoRS_MDB.EOF Then

MsgBox "Username not found!," vbOKOnly, "Not Found"

txtUserNm.Text = "

txtPasswrd.Text = "

Else

If adoRS_MDB.Fields ("Password").Value Trim (txtPasswrd.Text) Then

MsgBox "Invalid Password.," vbOKOnly, "Invalid Password"

txtPasswrd.Text = "

txtPasswrd.SetFocus

Else

recFound = True

End If

End If

adoRS_MDB.Close

If recFound Then

frmMain.cmdCustInput.Enabled = True

frmMain.cmdCarInput.Enabled = True

frmMain.cmdChrgCalc.Enabled = True

frmLogin.Hide

adoCon_MDB.Close

End If

End Sub

Private Sub-Form_Load ()

adoCon_MDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon_MDB.Open

End Sub

frmCarInput

Option Explicit

Dim adoCon As New ADODB.Connection

Dim adoRS As New ADODB.Recordset

Private Sub-Init ()

txtPlate.Text = "

cboCategory.Text = "

txtMaker.Text = "

txtMake.Text = "

txtYrModel.Text = "

txtPricePerDay.Text = "

End Sub

Private Sub-Toggle ()

cmdAdd.Enabled = False

cmdEdit.Enabled = False

txtPlate.Enabled = True

cboCategory.Enabled = True

txtMaker.Enabled = True

txtMake.Enabled = True

txtYrModel.Enabled = True

txtPricePerDay.Enabled = True

End Sub

Private Sub-cboPlate_Click ()

adoCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon.Open

adoRS.Source = "SELECT * FROM [Car List] WHERE [Plate Number] = '" & Trim (cboPlate.Text) & ""

adoRS.CursorType = adOpenDynamic

adoRS.ActiveConnection = adoCon

adoRS.Open

cboCategory.Text = adoRS.Fields ("Category")

txtMaker.Text = adoRS.Fields ("Maker")

txtMake.Text = adoRS.Fields ("Make")

txtYrModel.Text = adoRS.Fields ("Year Model")

txtPricePerDay.Text = adoRS.Fields ("Price Per Day")

adoRS.Close

adoCon.Close

End Sub

Private Sub-cmdAdd_Click ()

Toggle

cmdSave.Visible = True

cmdCancel.Visible = True

End Sub

Private Sub-cmdCancel_Click ()

cmdAdd.Enabled = True

cmdEdit.Enabled = True

Init

cboPlate.Visible = False

cboPlate.Enabled = False

txtPlate.Visible = True

txtPlate.Enabled = False

cboCategory.Enabled = False

txtMaker.Enabled = False

txtMake.Enabled = False

txtYrModel.Enabled = False

txtPricePerDay.Enabled = False

cmdSave.Visible = False

cmdCancel.Visible = False

cmdUpdate.Visible = False

End Sub

Private Sub-cmdEdit_Click ()

Dim x As Integer

Toggle

txtPlate.Enabled = False

txtPlate.Visible = False

cboPlate.Enabled = True

cboPlate.Visible = True

cmdUpdate.Visible = True

cmdCancel.Visible = True

adoCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon.Open

adoRS.Source = "SELECT * FROM [Car List]"

adoRS.CursorType = adOpenDynamic

adoRS.ActiveConnection = adoCon

adoRS.Open

adoRS.MoveFirst

Do While Not adoRS.EOF

With cboPlate

.AddItem adoRS.Fields ("Plate Number")

adoRS.MoveNext

End With

Loop

adoRS.Close

adoCon.Close

End Sub

Private Sub-cmdSave_Click ()

Dim strSQL As String

Dim adoCmd As New ADODB.Command

Dim adoCon_MDB As New ADODB.Connection

Dim allFilled As Boolean

allFilled = False

If Trim (txtPlate.Text) = " Then

txtPlate.SetFocus

ElseIf Trim (cboCategory.Text) = " Then

cboCategory.SetFocus

ElseIf Trim (txtMaker.Text) = " Then

txtMaker.SetFocus

ElseIf Trim (txtMake.Text) = " Then

txtMake.SetFocus

ElseIf Trim (txtYrModel.Text) = " Then

txtYrModel.SetFocus

ElseIf txtPricePerDay.Text = 0 Then

txtPricePerDay.SetFocus

Else

allFilled = True

End If

If Not allFilled Then

MsgBox "All fields require input.," vbOKOnly, "Message"

Exit Sub

End If

adoCon_MDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon_MDB.Open

strSQL = "INSERT INTO [Car List] ([Category], [Maker], [Make], [Year Model],"

strSQL = strSQL & " [Price Per Day], [Plate Number]) VALUES "

strSQL = strSQL & "('" & cboCategory.Text & ," '" & txtMaker.Text & ," '"

strSQL = strSQL & txtMake.Text & ," '" & txtYrModel.Text & ," '"

strSQL = strSQL & Format (txtPricePerDay.Text, "#######.00") & ," '" & txtPlate & ")"

adoCmd.CommandText = strSQL

adoCmd.CommandType = adCmdText

adoCmd.ActiveConnection = adoCon_MDB

adoCmd.Execute

Set adoCmd = Nothing

MsgBox "The record has been successfully added.," vbOKOnly, "Success"

adoCon_MDB.Close

Init

txtPlate.SetFocus

End Sub

Private Sub-cmdUpdate_Click ()

Dim strSQL As String

Dim adoCmd As New ADODB.Command

strSQL = "UPDATE [Car List] SET Category = '" & cboCategory.Text & ," "

strSQL = strSQL & "Maker = '" & txtMaker.Text & ," Make = '" & txtMake.Text & ," "

strSQL = strSQL & "[Year Model] = '" & txtYrModel.Text & ," [Price Per Day] = '" & txtPricePerDay.Text

strSQL = strSQL & " WHERE [Plate Number] = '" & cboPlate.Text & ""

adoCmd.CommandText = strSQL

adoCmd.CommandType = adCmdText

adoCmd.ActiveConnection = adoCon

adoCmd.Execute

Set adoCmd = Nothing

MsgBox "The record has been successfully updated.," vbOKOnly, "Success"

cboPlate.SetFocus

End Sub

frmCustInput

Option Explicit

Dim adoCon As New ADODB.Connection

Dim adoRS As New ADODB.Recordset

Dim adoCon2 As New ADODB.Connection

Dim adoRS2 As New ADODB.Recordset

Dim oName, oAddr, oCont, oPlate As String

Dim oCat, oNumDays As String

Dim recChanged

Private Sub-UpdateRec ()

Dim adoCon3 As New ADODB.Connection

adoCon3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon3.Open

strSQL = "INSERT INTO [Customer List] ([Customer Name], [Customer Address], [Contact Number], [Car Category],"

strSQL = strSQL & " [Plate Number], [Price Per Day], [Number of Days Rented], [VAT], [Final Charge]) VALUES "

strSQL = strSQL & "('" & txtCustName.Text & ," '" & txtAddress.Text & ," '"

strSQL = strSQL & txtContact.Text & ," '" & txtCategory.Text & ," '" & cboPlate.Text & ," '"

strSQL = strSQL & txtPricePerDay.Text & ," '" & txtNumDays.Text & ," '"

strSQL = strSQL & txtVAT.Text & ," '" & txtTotalChrg.Text & ")"

adoCmd.CommandText = strSQL

adoCmd.CommandType = adCmdText

adoCmd.ActiveConnection = adoCon3

adoCmd.Execute

Set adoCmd = Nothing

adoCon3.Close

End Sub

Private Sub-CheckIfEdited ()

recChanged = oName Trim (txtCustName.Text) Or

oAddr Trim (txtAddress.Text) Or

oCont Trim (txtContact.Text) Or

oPlate Trim (cboPlate.Text) Or

oCat Trim (txtCategory.Text) Or

oNumDays Trim (txtNumDays.Text)

End Sub

Private Sub-ShowRecord ()

txtCustName.Text = adoRS2.Fields ("Customer Name")

txtAddress.Text = adoRS2.Fields ("Customer Address")

txtContact.Text = adoRS2.Fields ("Contact Number")

cboPlate.Text = adoRS2.Fields ("Plate Number")

txtCategory.Text = adoRS2.Fields ("Car Category")

txtPricePerDay.Text = adoRS2.Fields ("Price Per Day")

txtNumDays.Text = adoRS2.Fields ("Number of Days Rented")

txtVAT.Text = adoRS2.Fields ("VAT")

txtTotalChrg.Text = adoRS2.Fields ("Final Charge")

oName = adoRS2.Fields ("Customer Name")

oAddr = adoRS2.Fields ("Customer Address")

oCont = adoRS2.Fields ("Contact Number")

oPlate = adoRS2.Fields ("Plate Number")

oCat = adoRS2.Fields ("Car Category")

oNumDays = adoRS2.Fields ("Number of Days Rented")

End Sub

Private Sub-ClearForm ()

txtCustName.Text = "

txtAddress.Text = "

txtContact.Text = "

cboPlate.Text = "

txtCategory.Text = "

txtPricePerDay.Text = "

txtNumDays.Text = "

txtVAT.Text = "

txtTotalChrg.Text = "

End Sub

Private Sub-DispComputedValues ()

If Not IsNumeric (txtPricePerDay.Text) Then

MsgBox "Plate Number field is required.," vbOKOnly, "Message"

cboPlate.SetFocus

Exit Sub

End If

If Not IsNumeric (txtNumDays.Text) Then

MsgBox "Number of Days Rented must contain a numeric data.," vbOKOnly, "Message"

txtNumDays.SetFocus

Exit Sub

End If

txtVAT.Text = (Val (txtNumDays.Text) * Val (txtPricePerDay.Text)) * 0.1

txtVAT.Text = Format (txtVAT.Text, "#######.00")

txtTotalChrg.Text = (Val (txtNumDays.Text) * Val (txtPricePerDay.Text)) + Val (txtVAT.Text)

txtTotalChrg.Text = Format (txtTotalChrg.Text, "#######.00")

End Sub

Private Sub-cboPlate_Click ()

adoRS.Source = "SELECT * FROM [Car List] WHERE [Plate Number] = '" & cboPlate.Text & ""

adoRS.CursorType = adOpenDynamic

adoRS.ActiveConnection = adoCon

adoRS.Open

txtPricePerDay.Text = adoRS.Fields ("Price Per Day")

txtCategory.Text = adoRS.Fields ("Category")

End Sub

Private Sub-cmdAdd_Click ()

Dim strSQL As String

Dim adoCmd As New ADODB.Command

If Trim (txtCustName.Text) = " Then

MsgBox "Customer Name field requires data.," vbOKOnly, "Message"

txtCustName.SetFocus

Exit Sub

ElseIf Trim (txtAddress.Text) = " Then

MsgBox "Address field requires data.," vbOKOnly, "Message"

txtAddress.SetFocus

Exit Sub

ElseIf Trim (txtContact.Text) = " Then

MsgBox "Contact Number field requires data.," vbOKOnly, "Message"

txtContact.SetFocus

Exit Sub

End If

DispComputedValues

adoCon2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:25690VB.mdb" adoCon2.Open

strSQL = "INSERT INTO [Customer List] ([Customer Name], [Customer Address], [Contact Number], [Car Category],"

strSQL = strSQL & " [Plate Number], [Price Per Day], [Number of Days Rented], [VAT], [Final Charge]) VALUES "

strSQL = strSQL & "('" & txtCustName.Text & ," '" & txtAddress.Text & ," '"

strSQL = strSQL & txtContact.Text & ," '" & txtCategory.Text & ," '" & cboPlate.Text & ," '"

strSQL = strSQL & txtPricePerDay.Text & ," '" & txtNumDays.Text & ," '"

strSQL = strSQL & txtVAT.Text & ," '" & txtTotalChrg.Text & ")"