frmmembers.frm

中小型图书会员制租赁管理系统,采用ACCESS数据库。

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 = "添加会员" Then
        Me.Caption = "Members (Add Mode)"
        lstMembers.Enabled = False
        cmdEdit.Enabled = False
        cmdAddMember.Caption = "取消添加"
        txtDateEntered.Text = Format(Now, "mmm. dd, yyyy")
        txtIDnumber.Text = "(自动编号)"
        cmdUpdate.Enabled = True
        cmdClear.Enabled = True
        Call cmdClear_Click
        txtAge.Text = "(自动计算)"
        Call UnlockTextboxes
        txtNationality.SetFocus
        Exit Sub
    End If
    
    If cmdAddMember.Caption = "取消添加" 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 = "添加会员"
        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 = "编辑" Then
     Me.Caption = "会员表(编辑状态)"
     cmdEdit.Caption = "取消编辑"
     lstMembers.Enabled = False
     cmdAddMember.Enabled = False
     cmdClear.Enabled = True
     cmdUpdate.Enabled = True
     Call UnlockTextboxes
     txtNationality.SetFocus
     Exit Sub
  End If
'------------------------------------------
  If cmdEdit.Caption = "取消编辑" Then
     Me.Caption = "会员表"
     cmdEdit.Caption = "编辑"
     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 cmdqzxs_Click()
Call LoadMembersqbzz(lstMembers)
End Sub
Sub LoadMembersqbzz(lst As ListBox) ''load UserNames in a listbox  往listbox里加载用户名
    On Error GoTo ErrorHandler:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    lst.Clear
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
      rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            'lst.AddItem rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & ". " & _
            rec.Fields("姓氏")
            lst.AddItem rec.Fields("ID NUMBER") & rec.Fields("姓氏") & ", " & rec.Fields("名字1") & Left(rec.Fields("名字2"), 1)
            rec.MoveNext
        Next loop1
     End If
  db.Close
  Exit Sub
ErrorHandler:
  db.Close
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("确定要删除此用户吗？ ", vbYesNo) = vbNo Then Exit Sub
  Call vr_engine.RemoveMember(Int(txtIDnumber.Text))
  Call vr_engine.LoadMembers(lstMembers, txtfw1, txtfw2) ' Refresh Members list
    Call cmdClear_Click
    txtDateEntered.Text = ""
    txtIDnumber.Text = ""
    txtAge.Text = ""
    cmdEdit.Enabled = False
    lstMembers.SetFocus
End If
End Sub

Private Sub cmdsxfw_Click()
Call Form_Load
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 = "取消添加" 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, txtfw1, txtfw2) ' Refresh Members list
        Me.Caption = "Members"
    Else
        Exit Sub
    End If
    
    ' Start - Enable Controls
    lstMembers.Enabled = True
    cmdAddMember.Caption = "添加会员"
    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 = "取消编辑" 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, txtfw1, txtfw2) ' Refresh Members list
        Me.Caption = "Members"
        cmdEdit.Caption = "编辑"
        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, txtfw1, txtfw2)
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 "请输入你的会员等级级别！ ", vbInformation, "Incomplete Information"
        txtNationality.SetFocus
        Exit Function
    End If
    
    If Trim(txtFirstName.Text) = "" Then
        MsgBox "请输入你的名字！", vbInformation, "Incomplete Information"
        txtFirstName.SetFocus
        Exit Function
    End If
    
    If Trim(txtMiddleName.Text) = "" Then
        If MsgBox("请输入你的名字2,如果为空，则跳过！ ", vbInformation, "要空缺名字2这项吗？") = vbYes Then
        txtMiddleName.SetFocus
        ValidateMembersInfo = True
        Exit Function
        End If
    End If
    
    If Trim(txtFamilyName.Text) = "" Then
        MsgBox "请输入你的姓氏 ", 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 "非法生日数据！", vbInformation, "Incomplete Information"
        txtBirthday.SetFocus
        Exit Function
    End If
    
    If Trim(txtSex.Text) <> "男" And Trim(txtSex.Text) <> "女" _
       And UCase(Trim(txtSex.Text)) <> "M" And UCase(Trim(txtSex.Text)) <> "F" Then
        'MsgBox txtSex.Text
        MsgBox "请输入性别项！ ", vbCritical, "错误"
        '''ValidateUserFields = 0
        txtSex.SetFocus
        Exit Function
    Else
           If UCase(Left(txtSex.Text, 1)) = "M" Then txtSex.Text = "男"
           If UCase(Left(txtSex.Text, 1)) = "F" Then txtSex.Text = "女"
    End If
    
    If Trim(txtCivilStatus.Text) = "" Then
        MsgBox "请输入你的公民身份！ ", vbInformation, "信息不完整"
        txtCivilStatus.SetFocus
        Exit Function
    End If
    
    If txtHomeAddress.Text = "" Then
        MsgBox "请输入你的家庭住址！ ", vbInformation, "信息不完整"
        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