📄 frmmembers.frm
字号:
Caption = "Family Name"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Index = 5
Left = 5040
TabIndex = 22
Tag = "&Password:"
Top = 1080
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Middle Name"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Index = 4
Left = 2640
TabIndex = 21
Tag = "&Password:"
Top = 1080
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "First Name"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Index = 3
Left = 240
TabIndex = 20
Tag = "&Password:"
Top = 1080
Width = 765
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "ID Number"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Index = 2
Left = 2640
TabIndex = 19
Tag = "&Password:"
Top = 480
Width = 735
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Date Entered"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 161
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Index = 0
Left = 240
TabIndex = 18
Tag = "&Password:"
Top = 480
Width = 1170
End
End
Begin VB.ListBox lstMembers
Height = 5130
Left = 360
Sorted = -1 'True
TabIndex = 1
ToolTipText = "List of members"
Top = 480
Width = 2175
End
Begin VB.Frame Frame1
Caption = " Members "
Height = 5775
Left = 120
TabIndex = 0
Top = 120
Width = 2655
End
End
Attribute VB_Name = "frmMembers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim lstTEXT As String
Private Sub cmdAddMember_Click()
If cmdAddMember.Caption = "&Add Member" Then
Me.Caption = "Members (Add Mode)"
lstMembers.Enabled = False
cmdEdit.Enabled = False
cmdAddMember.Caption = "C&ancel Add..."
txtDateEntered.Text = Format(Now, "mmm. dd, yyyy")
txtIDnumber.Text = "(AUTO-NUMBER)"
cmdUpdate.Enabled = True
cmdClear.Enabled = True
Call cmdClear_Click
txtAge.Text = "(SKIP THIS FEILD)"
Call UnlockTextboxes
txtNationality.SetFocus
Exit Sub
End If
If cmdAddMember.Caption = "C&ancel Add..." Then
Me.Caption = "Members"
Call cmdClear_Click
txtDateEntered.Text = ""
txtIDnumber.Text = ""
txtAge.Text = ""
Call LockTextboxes
lstMembers.Enabled = True
If Trim(lstTEXT) <> "" Then
lstMembers.Text = lstTEXT
Else
lstMembers.SetFocus
End If
cmdAddMember.Caption = "&Add Member"
cmdUpdate.Enabled = False
cmdClear.Enabled = False
Exit Sub
End If
End Sub
Private Sub cmdClear_Click()
txtNationality.Text = ""
txtFirstName.Text = ""
txtMiddleName.Text = ""
txtFamilyName.Text = ""
txtBirthday.Text = ""
txtSex.Text = ""
txtCivilStatus.Text = ""
txtOccupation.Text = ""
txtContactNumber.Text = ""
txtHomeAddress.Text = ""
txtOfficeSchoolAddress.Text = ""
txtComments.Text = ""
txtNationality.SetFocus
End Sub
Private Sub cmdEdit_Click()
'------------------------------------------
If cmdEdit.Caption = "&Edit" Then
Me.Caption = "Members (Edit Mode)"
cmdEdit.Caption = "Ca&ncel Edit"
lstMembers.Enabled = False
cmdAddMember.Enabled = False
cmdClear.Enabled = True
cmdUpdate.Enabled = True
Call UnlockTextboxes
txtNationality.SetFocus
Exit Sub
End If
'------------------------------------------
If cmdEdit.Caption = "Ca&ncel Edit" Then
Me.Caption = "Members"
cmdEdit.Caption = "&Edit"
lstMembers.Enabled = True
cmdAddMember.Enabled = True
cmdClear.Enabled = False
cmdUpdate.Enabled = False
If Trim(lstTEXT) <> "" Then
lstMembers.Text = lstTEXT
lstMembers.SetFocus
Else
lstMembers.SetFocus
End If
Call LockTextboxes
Exit Sub
End If
'-----------------------------------------
End Sub
Private Sub cmdRemove_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
If IsNumeric(txtIDnumber.Text) = True And lstMembers.Enabled = True Then
If MsgBox("Are you sure you want to delete this user? ", vbYesNo) = vbNo Then Exit Sub
Call vr_engine.RemoveMember(Int(txtIDnumber.Text))
Call vr_engine.LoadMembers(lstMembers) ' Refresh Members list
Call cmdClear_Click
txtDateEntered.Text = ""
txtIDnumber.Text = ""
txtAge.Text = ""
cmdEdit.Enabled = False
lstMembers.SetFocus
End If
End Sub
Private Sub cmdUpdate_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Dim X As Boolean
'-----------------------------------------------------
If cmdAddMember.Caption = "C&ancel Add..." Then
If ValidateMembersInfo = True Then
X = vr_engine.AddMemberToDB(txtDateEntered, txtIDnumber, txtNationality, _
txtFirstName, txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, txtCivilStatus, txtOccupation, _
txtContactNumber, txtHomeAddress, txtOfficeSchoolAddress, txtComments)
Call vr_engine.LoadMembers(lstMembers) ' Refresh Members list
Me.Caption = "Members"
Else
Exit Sub
End If
' Start - Enable Controls
lstMembers.Enabled = True
cmdAddMember.Caption = "&Add Member"
cmdAddMember.Enabled = True
lstMembers.Enabled = True
lstMembers.Text = Trim(txtFamilyName.Text) & ", " & Trim(txtFirstName.Text) & " " & Left(Trim(txtMiddleName.Text), 1) & "."
' End - Enable Controls
' Start - Disable Controls
cmdUpdate.Enabled = False
cmdClear.Enabled = False
' End - Disable Controls
Call LockTextboxes
lstMembers.SetFocus
Exit Sub
End If
'-----------------------------------------------------
'-----------------------------------------------------
If cmdEdit.Caption = "Ca&ncel Edit" Then
If ValidateMembersInfo = True Then
If vr_engine.UpdateEditedMembersDB(txtDateEntered, txtIDnumber, txtNationality, _
txtFirstName, txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, txtCivilStatus, txtOccupation, _
txtContactNumber, txtHomeAddress, txtOfficeSchoolAddress, txtComments) = True Then
'' Do Nothing
Else
Exit Sub
End If
Call vr_engine.LoadMembers(lstMembers) ' Refresh Members list
Me.Caption = "Members"
cmdEdit.Caption = "&Edit"
lstMembers.Enabled = True
cmdAddMember.Enabled = True
cmdClear.Enabled = False
cmdUpdate.Enabled = False
Call LockTextboxes
lstMembers.Text = Trim(txtFamilyName.Text) & ", " & Trim(txtFirstName.Text) & " " & Left(Trim(txtMiddleName.Text), 1) & "."
lstMembers.SetFocus
Else
Exit Sub
End If
End If
'-----------------------------------------------------
End Sub
Private Sub Form_Load()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.LoadMembers(lstMembers)
End Sub
Sub LockTextboxes()
txtNationality.Locked = True
txtFirstName.Locked = True
txtMiddleName.Locked = True
txtFamilyName.Locked = True
txtBirthday.Locked = True
txtSex.Locked = True
txtCivilStatus.Locked = True
txtOccupation.Locked = True
txtContactNumber.Locked = True
txtHomeAddress.Locked = True
txtOfficeSchoolAddress.Locked = True
txtComments.Locked = True
End Sub
Sub UnlockTextboxes()
txtNationality.Locked = False
txtFirstName.Locked = False
txtMiddleName.Locked = False
txtFamilyName.Locked = False
txtBirthday.Locked = False
txtSex.Locked = False
txtCivilStatus.Locked = False
txtOccupation.Locked = False
txtContactNumber.Locked = False
txtHomeAddress.Locked = False
txtOfficeSchoolAddress.Locked = False
txtComments.Locked = False
End Sub
Function ValidateMembersInfo() As Boolean
ValidateMembersInfo = False
If Trim(txtNationality.Text) = "" Then
MsgBox "Please Enter your Membership Level. ", vbInformation, "Incomplete Information"
txtNationality.SetFocus
Exit Function
End If
If Trim(txtFirstName.Text) = "" Then
MsgBox "Please Enter your Name. ", vbInformation, "Incomplete Information"
txtFirstName.SetFocus
Exit Function
End If
If Trim(txtMiddleName.Text) = "" Then
MsgBox "Please Enter your Middle Name. ", vbInformation, "Incomplete Information"
txtMiddleName.SetFocus
Exit Function
End If
If Trim(txtFamilyName.Text) = "" Then
MsgBox "Please Enter your Family Name. ", vbInformation, "Incomplete Information"
txtFamilyName.SetFocus
Exit Function
End If
If IsDate(Trim(txtBirthday.Text)) Then
txtBirthday.Text = Format(txtBirthday.Text, "mmm. d, yyyy")
Else
MsgBox "Invalid birth date. ", vbInformation, "Incomplete Information"
txtBirthday.SetFocus
Exit Function
End If
If UCase(Trim(txtSex.Text)) <> "MALE" And UCase(Trim(txtSex.Text)) <> "FEMALE" _
And UCase(Trim(txtSex.Text)) <> "M" And UCase(Trim(txtSex.Text)) <> "F" Then
'MsgBox txtSex.Text
MsgBox "Undetermined Sex!!! ", vbCritical, "Error"
'''ValidateUserFields = 0
txtSex.SetFocus
Exit Function
Else
If UCase(Left(txtSex.Text, 1)) = "M" Then txtSex.Text = "Male"
If UCase(Left(txtSex.Text, 1)) = "F" Then txtSex.Text = "Female"
End If
If Trim(txtCivilStatus.Text) = "" Then
MsgBox "Please Enter your Civil Status. ", vbInformation, "Incomplete Information"
txtCivilStatus.SetFocus
Exit Function
End If
If txtHomeAddress.Text = "" Then
MsgBox "Please Enter your Home Address. ", vbInformation, "Incomplete Information"
txtHomeAddress.SetFocus
Exit Function
End If
ValidateMembersInfo = True
End Function
Private Sub lstMembers_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
lstTEXT = lstMembers.Text '
Call vr_engine.GetMemberInfo(lstMembers, txtDateEntered, txtIDnumber, txtNationality, _
txtFirstName, txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, txtCivilStatus, txtOccupation, _
txtContactNumber, txtHomeAddress, txtOfficeSchoolAddress, txtComments)
txtAge.Text = vr_engine.GetAge(Format(txtBirthday.Text, "mmm. dd, yyyy"))
cmdEdit.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -