by by the name of "CristofferMarx (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 16th March 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Philippines-based Computer rental system. Complete with timers and billing charges It features a Counter (for Play 'n Pay modes), a countdown
API Declarations
'Written by : Kristopher Mark S. Advincula
' : [email protected]
'Project Started : December 18, 2004
'Project Completed : February 24, 2005
'Tittle : Cyber Computer Timer (Computer Rental System)
' : Microsystems Institute of Technology
' : Daet, Camarines Norte, Philippines
' : AY 2004 - 2005
'
'
'Note:
'
' -This is only a part of the project.
' -The timer has 2 modes, Play'n Pay & Time mode.
' -Play 'n pay (Open Session) is a counter which counts time usage
' -Time mode is a countdown timer with pre-set time codes
' -It calculates your usage and compute your bill
' -I also included a voice (pre-recorded voices) prompt to this project, but they are deactivated,
' to activate them, just de-comment all neccessary parameters
' -Hope this project will help a lot to novice VB programmers
' -For comments & suggestions, email me at [email protected]
'
'------------------------------------------------------------
'== This for playing a .Wav file as an alram ==
'Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
'(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'Dim fileName As String
'== Discount ==
Dim rdis As Integer
Dim idis As Integer
'== Billing for LAN ==
Dim r15 As Single
Dim r30 As Single
Dim r40 As Single
Dim r1 As Single
Dim r1up As Single
'== Billing for Online ==
Dim i15 As Single
Dim i30 As Single
Dim i40 As Single
Dim i1 As Single
Dim i1up As Single
'== For PC5 ==
Dim today5 As Date
Dim oras5 As Date
Dim hrs5 As Integer
Dim mins5 As Integer
Dim secs5 As Integer
Dim minuse5 As Integer
Dim hruse5 As Integer
Dim mbr5 As Integer
Dim hbr5 As Integer
Dim mbi5 As Integer
Dim hbi5 As Integer
Dim tbr5 As Single
Dim tbi5 As Single
Dim hb5 As Integer
Dim mb5 As Integer
VBcoders
'Setting Timer intervals
clctimer.Interval = 1000
Timer5.Interval = 1000
'initializing countdown timers
Timer5.Enabled = False
hrs5 = 0
mins5 = 0
secs5 = 0
oras5 = 0
'setting countdown limits
cmbhrs5.AddItem "5"
cmbhrs5.AddItem "4"
cmbhrs5.AddItem "3"
cmbhrs5.AddItem "2"
cmbhrs5.AddItem "1"
cmbhrs5.AddItem "0"
cmbmins5.AddItem "40"
cmbmins5.AddItem "30"
cmbmins5.AddItem "15"
cmbmins5.AddItem "0"
'declaration of values for billings
r15 = Val(rs15.Text)
r30 = Val(rs30.Text)
r40 = Val(rs40.Text)
r1 = Val(rs1.Text)
r1up = Val(rs1up.Text)
i15 = Val(is15.Text)
i30 = Val(is30.Text)
i40 = Val(is40.Text)
i1 = Val(is1.Text)
i1up = Val(is1up.Text)
'Ready
cn5.Text = " - Ready! -"
End Sub
Private Sub gensetdef_Click()
'this will load general setting defaults
rs15.Text = "5"
rs30.Text = "8"
rs40.Text = "10"
rs1.Text = "15"
rs1up.Text = "10"
is15.Text = "10"
is30.Text = "15"
is40.Text = "20"
is1.Text = "25"
is1up.Text = "20"
End Sub
Private Sub gensetok_Click()
'This save changes in the general settings
r15 = Val(rs15.Text)
r30 = Val(rs30.Text)
r40 = Val(rs40.Text)
r1 = Val(rs1.Text)
r1up = Val(rs1up.Text)
i15 = Val(is15.Text)
i30 = Val(is30.Text)
i40 = Val(is40.Text)
i1 = Val(is1.Text)
i1up = Val(is1up.Text)
'This will check for if the designated value for each time code is applicable
If r1 < r40 Or r40 < r30 Or r30 < r15 Or i1 < i40 Or i40 < i30 Or i30 < i15 Or rs1up.Text = "0" Or is1up.Text = "0" Then
If MsgBox("Invalid value designation! or Letters don't have numeric value,Restoring defaults.", vbOKOnly + vbCritical) = vbOK Then
rs15.Text = "5"
rs30.Text = "8"
rs40.Text = "10"
rs1.Text = "15"
rs1up.Text = "10"
is15.Text = "10"
is30.Text = "15"
is40.Text = "20"
is1.Text = "25"
is1up.Text = "20"
End If
Else
genset.Visible = False
pc5.Enabled = True
settingform.Enabled = True
End If
End Sub
Private Sub clctimer_Timer()
'shows system clock
offtime.Caption = Format(Time, "h:mm:ss AM/PM")
End Sub
Private Sub exitform_Click()
'This will exit the program
'This option will disable "Exit" if a timer is running
If cmdset5.Enabled = False Then
If MsgBox("Stop all active Timers first before quitting!", vbOKOnly + vbExclamation) = vbOK Then
End If
Else
'Confirmatory exit
If MsgBox("Do you want to Exit?", vbYesNo + vbCritical) = vbYes Then
'fileName = "C:\cyrix\exit.Wav"
'sndPlaySound fileName, 0
End
End If
End If
End Sub
Private Sub settingform_Click()
'This will load General setting menu
If cmdcan5.Enabled = True Then
If MsgBox("Stop all timers before setting options!", vbOKOnly + vbExclamation) = vbOK Then
End If
Else
If MsgBox("Reminder! Input only numeric figures. Although letter will still be accepted, it may give you incorrect 'Billing'.", vbOKOnly + vbExclamation) = vbOK Then
'fileName = "C:\cyrix\load.Wav"
'sndPlaySound fileName, 0
genset.Visible = True
pc5.Enabled = False
settingform.Enabled = False
End If
End If
End Sub
'========== PC5 PC5 PC5 ==============================================================
Private Sub cmdcan5_Click()
'Cancelation or Deactivation or Stopping of timers
If MsgBox("Stop this timer?", vbYesNo + vbExclamation) = vbYes Then
cmdcan5.Enabled = False
'fileName = "C:\cyrix\deact.Wav"
'sndPlaySound fileName, 0
'for Play 'n play
If setopn5.Value = True Then
today5 = Now
out5.Text = Format(today5, "hh:mm")
If TimeValue(in5.Text) > TimeValue(out5.Text) Or TimeValue(in5.Text) = TimeValue(out5.Text) Then
hr5.Text = "Invalid"
min5.Text = "Time"
cmdres5.Enabled = True
cmdres5.Caption = "Reset"
Else
diff = TimeValue(out5.Text) - TimeValue(in5.Text)
hourdiff = Hour(diff)
mindiff = Minute(diff)
hr5.Text = hourdiff
min5.Text = mindiff
cmdres5.Enabled = True
End If
'Billing
minuse5 = Val(min5.Text)
hruse5 = Val(hr5.Text)
If lan5.Value = True Then
Select Case hruse5
Case 1
hbr5 = hruse5 * r1
Case Is > 1
rdis = r1 - r1up
hbr5 = (hruse5 * r1up) + rdis
Case Else
hbr5 = 0
End Select
Select Case minuse5
Case 1 To 7
mbr5 = (r15 / 2) + 0.5
Case 8 To 15
mbr5 = r15
Case 16 To 23
mbr5 = (((r30 - r15) / 2) + r15) + 0.5
Case 24 To 30
mbr5 = r30
Case 31 To 35
mbr5 = (((r40 - r30) / 2) + r30) + 0.5
Case 36 To 40
mbr5 = r40
Case 41 To 50
mbr5 = (((r1 - r40) / 2) + r40) + 0.5
Case 51 To 59
mbr5 = r1
Case Else
mbr5 = 0
End Select
tbr5 = hbr5 + mbr5
due5.Text = Format(tbr5, "###,###.#0")
Else: onl5.Value = True
Select Case hruse5
Case 1
hbi5 = hruse5 * i1
Case Is > 1
idis = i1 - i1up
hbi5 = (hruse5 * i1up) + idis
Case Else
hbi5 = 0
End Select
Select Case minuse5
Case 1 To 7
mbi5 = (i15 / 2) + 0.5
Case 8 To 15
mbi5 = i15
Case 16 To 23
mbi5 = (((i30 - i15) / 2) + i15) + 0.5
Case 24 To 30
mbi5 = i30
Case 31 To 35
mbi5 = (((i40 - i30) / 2) + i30) + 0.5
Case 36 To 40
mbi5 = i40
Case 41 To 50
mbi5 = (((i1 - i40) / 2) + i40) + 0.5
Case 51 To 59
mbi5 = i1
Case Else
mbi5 = 0
End Select
tbi5 = hbi5 + mbi5
due5.Text = Format(tbi5, "###,###.#0")
cmdcan5.Enabled = False
End If
'for countdown timer
Else: setlim5.Value = True
Timer5.Enabled = False
cmdres5.Enabled = True
'Billing
minuse5 = Val(min5.Text)
hruse5 = Val(hr5.Text)
If lan5.Value = True Then
Select Case hruse5
Case 1
hbr5 = hruse5 * r1
Case Is > 1
rdis = r1 - r1up
hbr5 = (hruse5 * r1up) + rdis
Case Else
hbr5 = 0
End Select
Select Case minuse5
Case 15
mbr5 = r15
Case 30
mbr5 = r30
Case 40
mbr5 = r40
Case Else
mbr5 = 0
End Select
tbr5 = hbr5 + mbr5
due5.Text = Format(tbr5, "###,###.#0")
Else: onl5.Value = True
Select Case hruse5
Case 1
hbi5 = hruse5 * i1
Case Is > 1
idis = i1 - i1up
hbi5 = (hruse5 * i1up) + idis
Case Else
hbi5 = 0
End Select
Select Case minuse5
Case 15
mbi5 = i15
Case 30
mbi5 = i30
Case 40
mbi5 = i40
Case Else
mbi5 = 0
End Select
tbi5 = hbi5 + mbi5
due5.Text = Format(tbi5, "###,###.#0")
cmdcan5.Enabled = False
End If
End If
cmdres5.SetFocus
End If
End Sub
Private Sub cmdres5_Click()
cmdset5.Enabled = True
'resetting
cmdres5.Enabled = False
hr5.Text = ""
min5.Text = ""
in5.Text = ""
out5.Text = ""
cn5.Text = "- Ready! -"
in5.BackColor = &H80000005
cn5.BackColor = &H80000005
cn5.ForeColor = &H0&
due5.Text = ""
cmbhrs5.Text = ""
cmbmins5.Text = ""
lan5.Value = True
setopn5.Value = True
cmdres5.Caption = "Paid"
End Sub
Private Sub cmdset5_Click()
'Setting the timer
set5.Visible = True
cus5.Text = "- Customer's Name -"
cmbhrs5.Text = "0"
cmbmins5.Text = "0"
pc5.Enabled = False
End Sub
Private Sub setcan5_Click()
'cancellation of timers
set5.Visible = False
pc5.Enabled = True
setopn5.Value = True
lan5.Value = True
End Sub
Private Sub setlim5_Click()
'counter guard for countdown during Play 'n pay
limit5.Enabled = True
End Sub
Private Sub setstr5_Click()
'setted timer
'Play 'n Pay
If cus5.Text = "- Customer's Name -" Or cus5.Text = "" Then
If MsgBox("Please enter your customer's name", vbOKOnly) = vbOK Then
setopn5.Value = True
End If
Else
If setopn5.Value = True Then
today5 = Now
in5.Text = Format(today5, "hh:mm")
out5.Text = "Play 'n Pay"
pc5.Enabled = True
cmdset5.Enabled = False
cmdcan5.Enabled = True
set5.Visible = False
cn5.Text = cus5.Text
'fileName = "C:\cyrix\act.Wav"
'sndPlaySound fileName, 0
'Countdown
Else: setlim5.Value = True
hrs5 = Val(cmbhrs5.Text)
mins5 = Val(cmbmins5.Text)
secs5 = 0
If cmbhrs5.Text = "0" And cmbmins5.Text = "0" And secs5 = 0 Or hrs5 > 12 Or mins5 > 59 Then
If MsgBox("Please enter a valid time.", vbOKOnly + vbExclamation) = vbOK Then
setopn5.Value = True
End If
Else
'this will covert time codes to time serials
hr5.Text = cmbhrs5.Text
min5.Text = cmbmins5.Text
oras5 = TimeSerial(hrs5, mins5, secs5)
Timer5.Enabled = True
set5.Visible = False
today5 = Now
in5.Text = Format(today5, "hh:mm AM/PM")
pc5.Enabled = True
cmdcan5.Enabled = True
cmdset5.Enabled = False
cn5.Text = cus5.Text
'fileName = "C:\cyrix\act.Wav"
'sndPlaySound fileName, 0
End If
End If
'cmdcan5.SetFocus
End If
limit5.Enabled = False
End Sub
Private Sub Timer5_Timer()
'this will compute for countdiown timer
Timer5.Enabled = False
If (Format$(oras5, "hh") & ":" & Format$(oras5, "nn") & ":" & Format$(oras5, "ss")) <> "00:00:00" Then
oras5 = DateAdd("s", -1, oras5)
out5.Visible = False
out5.Text = Format$(oras5, "hh") & ":" & Format$(oras5, "nn") & ":" & Format$(oras5, "ss")
out5.Visible = True
Timer5.Enabled = True
If out5.Text = "00:05:00" Then
in5.BackColor = &H8000&
End If
If out5.Text = "00:01:00" Then
in5.BackColor = &H80FF&
'fileName = "C:\cyrix\warn.Wav"
'sndPlaySound fileName, 0
End If
Else
Timer5.Enabled = False
out5.BackColor = &H80000005
out5.Text = "Time Out!"
cn5.BackColor = &HFF&
cn5.ForeColor = &H80000005
cmdcan5.Enabled = False
cmdres5.Enabled = True
'fileName = "C:\cyrix\pc5.Wav"
'sndPlaySound fileName, 0
'Billing
minuse5 = Val(min5.Text)
hruse5 = Val(hr5.Text)
If lan5.Value = True Then
Select Case hruse5
Case 1
hbr5 = hruse5 * r1
Case Is > 1
rdis = r1 - r1up
hbr5 = (hruse5 * r1up) + rdis
Case Else
hbr5 = 0
End Select
Select Case minuse5
Case 15
mbr5 = r15
Case 30
mbr5 = r30
Case 40
mbr5 = r40
Case Else
mbr5 = 0
End Select
tbr5 = hbr5 + mbr5
due5.Text = Format(tbr5, "###,###.#0")
Else: onl5.Value = True
Select Case hruse5
Case 1
hbi5 = hruse5 * i1
Case Is > 1
idis = i1 - i1up
hbi5 = (hruse5 * i1up) + idis
Case Else
hbi5 = 0
End Select
Select Case minuse5
Case 15
mbi5 = i15
Case 30
mbi5 = i30
Case 40
mbi5 = i40
Case Else
mbi5 = 0
End Select
tbi5 = hbi5 + mbi5
due5.Text = Format(tbi5, "###,###.#0")
cmdcan5.Enabled = False
End If
End If
End Sub
No comments have been posted about Philippines-based Computer rental system. Complete with timers and billing charges It features a Co. Why not be the first to post a comment about Philippines-based Computer rental system. Complete with timers and billing charges It features a Co.