frmassess.frm

simple supermarket for beginners

         TabIndex        =   6
         Top             =   1440
         Width           =   1335
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "Truck"
         Height          =   255
         Index           =   9
         Left            =   120
         TabIndex        =   5
         Top             =   480
         Width           =   1335
      End
   End
   Begin VB.CommandButton cmdcalculate 
      BackColor       =   &H00E0E0E0&
      Caption         =   "calculate"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   7680
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   5400
      Width           =   2175
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Cost - Benefit Analysis"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   435
      Index           =   5
      Left            =   4560
      TabIndex        =   27
      Top             =   600
      Width           =   4530
   End
End
Attribute VB_Name = "frmassess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim validated As Boolean
Dim vaccumated As Boolean
Dim cn As ADODB.Connection
Dim RS As ADODB.Recordset, rs2 As ADODB.Recordset, rs3 As ADODB.Recordset, rs4 As Recordset
Dim change As Boolean
Dim consumption As Double, distance As Double, wage As Double, mileage As Double
Dim fuelcost As Double, totalcost As Double, amountoffered As Double, profit As Double

Private Sub cbodestination_Click()
Label1(8).ForeColor = vbBlack
End Sub

Private Sub cbodestination_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cbofrom_Click()
Label1(7).ForeColor = vbBlack
cbodestination.Enabled = False
rs3.Open "Select * from routes where From='" & cbofrom.Text & "'", cn
cbodestination.clear
    If rs3.EOF = False Then
        Do
            cbodestination.AddItem rs3("Destination")
            rs3.MoveNext
        Loop Until rs3.EOF = True
    Else
        cbodestination.AddItem rs3("Destination")
    End If
rs3.Close
cbodestination.Enabled = True

End Sub

Private Sub cbofrom_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cbotruck_Click()
Label1(9).ForeColor = vbBlack
cbofrom.Enabled = True
End Sub

Private Sub cbotruck_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cmdcalculate_Click()
vaccumate
If vaccumated = False Then
    Exit Sub
End If

validate
If validated = False Then
    Exit Sub
End If
    Set rs4 = New ADODB.Recordset
    rs4.Open " select * from Vehicle where Reg_Number='" & cbotruck.Text & "'", cn, adOpenDynamic, adLockPessimistic
        txtf_cons.Text = rs4("Fuel_Consumption")
    rs3.Open "Select * from routes where From='" & cbofrom.Text & "' and Destination='" & cbodestination.Text & "'", cn
        txtdistance.Text = rs3("Distance")
    rs3.Close

    'Assign textboxes
    consumption = val(txtf_cons.Text)
    distance = val(txtdistance.Text)
    wage = val(txtwages.Text)
    mileage = val(txtmileage.Text)
    
    fuelcost = val(consumption * distance)
    totalcost = fuelcost + wage + mileage
    amountoffered = val(TXTAMOUNTOFFERED.Text)
    profit = amountoffered - totalcost
    
    txtfcost.Text = fuelcost
    txttotalcost.Text = totalcost
    TXTBENEFIT.Text = profit
End Sub

Private Sub Form_Load()

Set cn = New ADODB.Connection
Set RS = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
Set rs3 = New ADODB.Recordset

cn.Provider = "Microsoft Jet 4.0 OLE DB Provider"
cn.ConnectionString = "Data Source=TRANSPORT.MDB"
cn.Open
RS.Open "select * from vehicle", cn, adOpenDynamic, adLockPessimistic
rs2.Open "select* from routes", cn
popul8_combo
End Sub

Public Sub Display()
Dim I As Integer
End Sub


Public Sub popul8_combo()
Do While Not rs2.EOF = True
    cbofrom.AddItem rs2("From")
    rs2.MoveNext
Loop

Do While Not RS.EOF ' = True
    cbotruck.AddItem RS("Reg_Number")
    RS.MoveNext
Loop

End Sub

Public Sub vaccumate()

    If cbotruck.Text = "" Then
        Label1(9).ForeColor = vbRed
        MsgBox "Chose the truck you intend to undertake the trip!", vbCritical, "Data Required!"
        cbotruck.SetFocus
        vaccumated = False
        Exit Sub
    ElseIf cbofrom.Text = "" Then
        Label1(7).ForeColor = vbRed
        MsgBox "Knowledge of where the truck is coming from is needed!" & Chr(13) & "Helps Calculate the distance", vbCritical, "Data Required!"
        cbofrom.SetFocus
        vaccumated = False
        Exit Sub
    ElseIf cbodestination.Text = "" Then
        Label1(8).ForeColor = vbRed
        MsgBox "The Destination is required!", vbCritical, "Data Required!"
        cbodestination.SetFocus
        vaccumated = False
        Exit Sub
    ElseIf TXTAMOUNTOFFERED.Text = "" Then
        Label2(0).ForeColor = vbRed
        MsgBox "Amount offered for thee trip is required!", vbCritical, "Data Required!"
        TXTAMOUNTOFFERED.SetFocus
        vaccumated = False
        Exit Sub
    Else
        vaccumated = True
    End If

End Sub

Public Sub validate()
    If txtwages.Text <> "" And Not IsNumeric(txtwages.Text) Then
        Label1(2).ForeColor = vbRed
        MsgBox "The Driver and co driver's wages Should be in Digit$!", vbCritical, "Data Required!"
        txtwages.SetFocus
        SendKeys "{Home}+{End}"
        validated = False
        Exit Sub
    Else
        validated = True
    End If
    
    If txtmileage.Text <> "" And Not IsNumeric(txtmileage.Text) Then
        Label1(3).ForeColor = vbRed
        MsgBox "Mileage for the trip Should be in Digit$!", vbCritical, "Data Required!"
        txtmileage.SetFocus
        SendKeys "{Home}+{End}"
        validated = False
        Exit Sub
    Else
        validated = True
    End If
    
    If Not IsNumeric(TXTAMOUNTOFFERED.Text) Then
        Label2(0).ForeColor = vbRed
        MsgBox "Amount offered for the trip Should be in Digit$!", vbCritical, "Data Required!"
        TXTAMOUNTOFFERED.SetFocus
        SendKeys "{Home}+{End}"
        validated = False
        Exit Sub
    Else
        validated = True
    End If
End Sub

Private Sub TXTAMOUNTOFFERED_Change()
Label2(0).ForeColor = vbBlack
cmdcalculate.Enabled = True
End Sub

Private Sub TXTAMOUNTOFFERED_KeyPress(KeyAscii As Integer)
'Sorry for the erdundancy didnt know a way around it
'there's room for comments and suggestion at [e-mail].
    Select Case KeyAscii
        Case 13
            TXTAMOUNTOFFERED.SetFocus
        Case 8
            KeyAscii = 8
        Case 48
            KeyAscii = 48
        Case 49
            KeyAscii = 49
        Case 50
            KeyAscii = 50
        Case 51
            KeyAscii = 51
        Case 52
            KeyAscii = 52
        Case 53
            KeyAscii = 53
        Case 54
            KeyAscii = 54
        Case 55
            KeyAscii = 55
        Case 56
            KeyAscii = 56
        Case 57
            KeyAscii = 57
        Case 58
            KeyAscii = 58
        Case Else
            KeyAscii = 0
    End Select


End Sub

Private Sub txtmileage_KeyPress(KeyAscii As Integer)
'Sorry for the erdundancy didnt know a way around it
'there's room for comments and suggestion at [e-mail].
    Select Case KeyAscii
        Case 13
            TXTAMOUNTOFFERED.SetFocus
        Case 8
            KeyAscii = 8
        Case 48
            KeyAscii = 48
        Case 49
            KeyAscii = 49
        Case 50
            KeyAscii = 50
        Case 51
            KeyAscii = 51
        Case 52
            KeyAscii = 52
        Case 53
            KeyAscii = 53
        Case 54
            KeyAscii = 54
        Case 55
            KeyAscii = 55
        Case 56
            KeyAscii = 56
        Case 57
            KeyAscii = 57
        Case 58
            KeyAscii = 58
        Case Else
            KeyAscii = 0
    End Select

End Sub

Private Sub txtwages_KeyPress(KeyAscii As Integer)
'Ensure that numbers are the only valid input
'this i do by using the Ascii number of the keys and explicitly stating which
'keys i'll allow to enter data. I tried using a less redundant and also faster
'to type i.e. using the case(48 - 58) but it did'nt work so i had to type each case
'individually. The voluminous code inspired me to use a function which jus could'nt
'work. if you have a way around this, [e-mail] is the place to send it!!!!
    Select Case KeyAscii
        Case 13
            txtmileage.SetFocus
        Case 8
            KeyAscii = 8
        Case 48
            KeyAscii = 48
        Case 49
            KeyAscii = 49
        Case 50
            KeyAscii = 50
        Case 51
            KeyAscii = 51
        Case 52
            KeyAscii = 52
        Case 53
            KeyAscii = 53
        Case 54
            KeyAscii = 54
        Case 55
            KeyAscii = 55
        Case 56
            KeyAscii = 56
        Case 57
            KeyAscii = 57
        Case 58
            KeyAscii = 58
        Case Else
            KeyAscii = 0
    End Select

End Sub