Option Explicit
Dim flag As Integer
Dim mblnBrow As Boolean
Dim mintClear As Integer
Dim mintFind As Integer
Dim mblnCheck As Boolean
Dim mdatGExp As Date
Dim mdatTExp As Date
Dim mdatOD As Date
Dim mintOD As Integer
Dim mblnExpOD As Boolean
Dim a As Single
Dim b As Single
Dim c As Single
Private Sub cmdBrowse_Click()
If mblnBrow = True Then Form_Load
End Sub
Private Sub cmdExp_Click()
If mblnExpOD = True Then Form_Load
mrstGym.MoveFirst
Do Until mrstGym.EOF
If mrstGym!fldGExp = True Or mrstGym!fldTExp = True Then
mblnBrow = True
Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers WHERE fldGExp = true or fldTExp=true ORDER BY fldMemberID")
ShowRecord
mintFind = 0
mblnExpOD = True
Exit Sub
Else
mrstGym.MoveNext
End If
Loop
MsgBox "Non ci sono clienti scaduti!!!", vbOKOnly + vbInformation
Form_Load
End Sub
Private Sub cmdFind_Click()
mintClear = 1
mintFind = 1
txtId.SetFocus
ClearRecord
Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers ORDER BY fldMemberID")
End Sub
Private Sub cmdUpdate_Click()
WriteRecord
mrstGym.Update
a = txtAmountdue.Text
b = txtInstall.Text
lblBalance.Caption = a - b
End Sub
Private Sub cmdEnter_Click()
mrstGym.AddNew
ClearRecord
txtLastName.SetFocus
flag = 1
End Sub
Private Sub cmdFirst_Click()
mrstGym.MoveFirst
ShowRecord
End Sub
Private Sub cmdLast_Click()
mrstGym.MoveLast
ShowRecord
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub cmdNext_Click()
mrstGym.MoveNext
If mrstGym.EOF Then mrstGym.MoveLast
ShowRecord
End Sub
Private Sub cmdPrev_Click()
mrstGym.MovePrevious
If mrstGym.BOF Then mrstGym.MoveFirst
ShowRecord
End Sub
Private Sub Command1_Click()
Dim i As Long
frmGym.Top = (Screen.Height / 2) - (Me.Height / 2)
frmGym.Left = (Screen.Width / 2) - (Me.Width / 2)
For i = frmGym.Left To (Screen.Width / 2) Step 10
frmGym.Height = Me.Height - 15
frmGym.Left = Me.Left + 100
DoEvents
Next
Unload Me
End Sub
Private Sub Form_Load()
Set pdbMembers = OpenDatabase(App.Path & "\Gym_Members.mdb")
Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers ORDER BY fldMemberID")
mblnBrow = False
cmdFirst_Click
End Sub
Public Sub ShowRecord()
With mrstGym
txtId = !fldMemberID
txtLastName = !fldLastName
txtFirstName = !fldFirstName
If !fldGender = "M" Then optM = True
If !fldGender = "F" Then optF = True
If !fldMemberShip = "Gym" Then optGym = True
If !fldMemberShip = "Tanning" Then optTanning = True
If !fldMemberShip = "Gym & Tanning" Then optGym_Tanning = True
If !fldGymEx <> "" Then
mdatGExp = !fldGymEx
If mdatGExp < Date Then
.Edit
!fldGExp = True
.Update
txtEx_gym.Width = 975
txtEx_gym.ForeColor = vbBlack
txtEx_gym = !fldGymEx
Else
.Edit
!fldGExp = False
.Update
txtEx_gym.Width = 1695
txtEx_gym.ForeColor = vbBlack
txtEx_gym = !fldGymEx
End If
Else
.Edit
!fldGExp = False
.Update
txtEx_gym.Width = 1695
txtEx_gym = ""
End If
If !fldTanEx <> "" Then
mdatTExp = !fldTanEx
If mdatTExp < Date Then
.Edit
!fldTExp = True
.Update
txtEx_tan.Width = 975
txtEx_tan.ForeColor = vbBlack
txtEx_tan = !fldTanEx
Else
.Edit
!fldTExp = False
.Update
txtEx_tan.Width = 1695
txtEx_tan.ForeColor = vbBlack
txtEx_tan = !fldTanEx
End If
Else
.Edit
!fldTExp = False
.Update
txtEx_tan.Width = 1695
txtEx_tan = ""
End If
txtStreet = !fldStreet
txtCity = !fldCity
txtPhone = !fldPhoneNumber
If !fldPayDue <> "" Then
txtPayduedate = !fldPayDue
mdatOD = !fldPayDue
mintOD = Date - mdatOD
If mintOD > 0 Then
.Edit
!fldOD = True
.Update
Else
.Edit
!fldOD = False
.Update
End If
Else
txtPayduedate = ""
.Edit
!fldOD = False
.Update
End If
txtAmountdue = Format(!fldAmountDue, "Currency")
txtInstall = Format(!fldInstallAmount, "Currency")
lblBalance = Format(!fldBalance, "Currency")
If !fldNotes <> "" Then txtNotes = !fldNotes Else txtNotes = ""
End With
End Sub
Public Sub ClearRecord()
If mintClear = 1 Then
txtId = ""
mintClear = 0
Else
txtId = mrstGym!fldMemberID
End If
txtLastName = ""
txtFirstName = ""
optM.Value = False
optM.TabStop = True
optF.Value = False
optGym.Value = False
optGym.TabStop = True
optTanning.Value = False
optGym_Tanning.Value = False
txtEx_gym = ""
txtEx_tan = ""
txtStreet = ""
txtCity = ""
txtZip = ""
txtPhone = ""
txtPayduedate = ""
txtAmountdue = ""
txtInstall = ""
lblBalance = Format(0, "Currency")
txtNotes = ""
txtEx_gym.Width = 1695
txtEx_tan.Width = 1695
End Sub
Public Sub WriteRecord()
With mrstGym
If flag = 1 Then
!fldMemberID = txtId
flag = 0
Else
.Edit
End If
!fldLastName = txtLastName
!fldFirstName = txtFirstName
If optM = True Then !fldGender = "M"
If optF = True Then !fldGender = "F"
If optGym = True Then !fldMemberShip = "Gym"
If optTanning = True Then !fldMemberShip = "Tanning"
If optGym_Tanning = True Then !fldMemberShip = "Gym & Tanning"
If txtEx_gym <> "" Then !fldGymEx = txtEx_gym Else !fldGymEx = Null
If txtEx_tan <> "" Then !fldTanEx = txtEx_tan Else !fldTanEx = Null
!fldStreet = txtStreet
!fldCity = txtCity
!fldPhoneNumber = txtPhone
If txtPayduedate <> "" Then !fldPayDue = txtPayduedate Else !fldPayDue = Null
If txtAmountdue <> "" Then !fldAmountDue = txtAmountdue Else !fldAmountDue = "0"
If txtInstall <> "" Then !fldInstallAmount = txtInstall Else !fldInstallAmount = "0"
!fldBalance = lblBalance
If txtNotes <> "" Then !fldNotes = txtNotes Else !fldNotes = ""
End With
End Sub
Private Sub txtId_KeyPress(KeyAscii As Integer)
If mintFind = 1 Then
If KeyAscii = 13 Then
mrstGym.MoveFirst
Do Until mrstGym.EOF
If txtId = mrstGym!fldMemberID Then
ShowRecord
mintFind = 0
Exit Sub
Else
mrstGym.MoveNext
End If
Loop
MsgBox "Cliente Inesistente", vbOKOnly + vbInformation, "Errore!"
txtId.SelStart = 0
txtId.SelLength = Len(txtId)
End If
End If
End Sub
Private Sub txtLastName_KeyPress(KeyAscii As Integer)
If mintFind = 1 Then
If KeyAscii = 13 Then
mrstGym.MoveFirst
Do Until mrstGym.EOF
If txtLastName = mrstGym!fldLastName Then
mblnBrow = True
Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers WHERE fldLastName = '" & txtLastName & "' ORDER BY fldMemberID")
ShowRecord
mintFind = 0
Exit Sub
Else
mrstGym.MoveNext
End If
Loop
MsgBox "Il Cliente non esiste", vbOKOnly + vbInformation, "Inserimento errato"
txtLastName.SelStart = 0
txtLastName.SelLength = Len(txtLastName)
End If
End If
End Sub
