frmclientreg.frm

健身俱乐部管理系统

      _ExtentY        =   582
      caption         =   "保存"
   End
   Begin XP_Button.XPButton BtnCancel 
      Height          =   330
      Left            =   8655
      TabIndex        =   1
      Top             =   5850
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   582
      caption         =   "返回"
   End
End
Attribute VB_Name = "FrmClientReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Rs_Member As ADODB.Recordset '会员

Dim OpenFileName As String

Private Sub BtnCancel_Click()
    Unload Me
End Sub

Private Sub btnPhoto_Click()

    On Error Resume Next
    dlgPic.CancelError = True '返回或设置一个值，该值指示当选取“取消”按钮时是否出错
    dlgPic.FileName = ""
    dlgPic.Filter = "图片(*.*)|*.*"   '& vbCrLf & "图片(*.jpg)|*.jpg"     '设置保存类型
    dlgPic.ShowOpen

    OpenFileName = dlgPic.FileName
    Me.ImgPhoto.Picture = LoadPicture(OpenFileName)
    If Err = 481 Then
        MsgBox "您选择的文件不是图片或该图片类型不能识别", vbInformation, "提示"
        OpenFileName = ""
        Exit Sub
    End If
    
    dlgPic.FileName = ""
    If Err.Number = 32755 Then '按了取消
        Exit Sub
    End If




End Sub

Private Sub Form_Load()
    Me.Show '必须的否则控件的SetFocus 方法会失败
    TxtName.SetFocus '输入姓名文本框获得焦点
    '时间选择控件初始化
    Me.dtpStartingTime.Value = Format(Now, "short date")
    Me.dtpBoxStarting.Value = Format(Now, "short date")
    Me.dtpDeadline.Value = CDate(Format(Now, "yyyy-12-31"))
    Me.dtpBoxDeadLine.Value = CDate(Format(Now, "yyyy-12-31"))
    Call MdlDB.DataIni '数据库连接


    
End Sub
'保存信息
Private Sub BtnSave_Click()
    Dim Flag_test As Boolean
    '验证输入的会员信息
    Flag_test = TestInput
    If Flag_test = False Then
        Exit Sub
    End If
    
    '*************保存会员信息*****************************
    Set Rs_Member = New ADODB.Recordset
    Rs_Member.Open "SELECT * FROM Member", CN, adOpenStatic, adLockOptimistic
    Rs_Member.AddNew

    '保存会员照片
    Flag_test = MdlPic.SavePic(OpenFileName, Rs_Member)
    If Flag_test = False Then
        'Set Rs_Member = Nothing
        'Exit Sub '退出
    End If
    'Rs_Member!ID = Me.TxtCard.Text '会员卡
    Rs_Member!IDCard = Me.TxtIDCard.Text   '身份证
    Rs_Member!Name = Me.TxtName.Text '姓名
    '性别
    If Me.optSex(0).Value = True Then
        Rs_Member!Sex = "男"   '男性
    Else
        Rs_Member!Sex = "女"   '女性
    End If
    
    Rs_Member!Birthday = Me.dtpBirthday.Value '生日
    Rs_Member!Handset = Me.TxtHandSet.Text '移动电话
    Rs_Member!HomeTel = Me.TxtHomeTel.Text   '固定电话
    Rs_Member!Address = Me.TxtAddress.Text   '住址
    Rs_Member!Company = Me.TxtCompany.Text  '工作单位

    '*************保存会员卡信息*****************************
    
    Dim Rs_Card As ADODB.Recordset
    Set Rs_Card = New ADODB.Recordset
    Rs_Card.Open "SELECT * FROM Card Where ID ='" & Me.TxtCard.Text & "'", CN, adOpenStatic, adLockOptimistic
    
    If Not Rs_Card.EOF Then
        '判断该会员卡是否过期
        If DateDiff("d", Now, Rs_Card!Deadline) >= 0 Then
            MsgBox "该会员卡尚未过期,请重新填写！"
            Me.TxtCard.Text = ""
            Exit Sub '退出
        Else
    
            '该卡在数据库中已经存在,但已经过期
            Rs_Card!UserID = Me.TxtIDCard.Text  '使用者编号(身份证号)
            Rs_Card!StartingTime = Me.dtpStartingTime.Value  '起始时间
            Rs_Card!Deadline = Me.dtpDeadline.Value  '截止时间
            Rs_Card!InOutTimes = 0 '使用次数
        End If
    
    Else
        '新卡
        Rs_Card.AddNew
        
        Rs_Card!Id = Me.TxtCard.Text '卡号
        Rs_Card!UserID = Me.TxtIDCard.Text  '使用者编号
        Rs_Card!StartingTime = Me.dtpStartingTime.Value  '起始时间
        Rs_Card!Deadline = Me.dtpDeadline.Value  '截止时间
        Rs_Card!InOutTimes = 0 '使用次数
      
    End If

    
    '************储物箱**************************
    Dim Rs_Chest As ADODB.Recordset
    Set Rs_Chest = New ADODB.Recordset
    Rs_Chest.Open "SELECT * FROM Chest Where ID ='" & Me.TxtChest.Text & "'", CN, adOpenStatic, adLockOptimistic
    
    If Not Rs_Chest.EOF Then
        '判断该箱是否已经在使用中(刨除箱号为空的情况)
        If DateDiff("d", Now, Rs_Chest!Deadline) >= 0 And Me.TxtChest.Text <> "" Then
            MsgBox "该储物箱正在使用中,请重新填写！"
            Me.TxtChest.Text = ""
            Exit Sub '退出
        End If
    
        '该箱在数据库中已经存在
        Rs_Chest!Id = Me.TxtChest.Text '箱号
        Rs_Chest!UserID = Me.TxtIDCard.Text  '使用者编号(身份证号)
        Rs_Chest!StartingTime = Me.dtpBoxStarting.Value '起始时间
        Rs_Chest!Deadline = Me.dtpBoxDeadLine.Value  '截止时间

    Else
        '新箱
        Rs_Chest.AddNew
        Rs_Chest!Id = Me.TxtChest.Text '箱号
        Rs_Chest!UserID = Me.TxtIDCard.Text '使用者编号(身份证号)
        Rs_Chest!StartingTime = Me.dtpBoxStarting.Value  '起始时间
        Rs_Chest!Deadline = Me.dtpBoxDeadLine.Value  '截止时间

    End If

    '如果都正常就保存该信息
    Rs_Member.Update
    Rs_Member.Close
    Set Rs_Member = Nothing
    
    '会员卡
    Rs_Card.Update
    Rs_Card.Close
    Set Rs_Card = Nothing
    
    '储物箱
    Rs_Chest.Update
    Rs_Chest.Close
    Set Rs_Chest = Nothing

    MsgBox "新会员注册成功"
    Unload Me
End Sub

'Option Explicit







Private Sub SSTab1_DblClick()

End Sub


'自动滤掉不合格的字符
Private Sub TxtCard_Change()
    Dim i As Integer
    Dim TxtStr As String
    Dim GetTxt As String
    GetTxt = Me.TxtCard.Text
    Dim OverTxt As String
    For i = 1 To Len(GetTxt)
        Dim OneChar As String
        OneChar = Mid(GetTxt, i, 1)
        If IsNumeric(OneChar) Then
            OverTxt = OverTxt & OneChar
        End If
    Next
    Me.TxtCard.Text = OverTxt
    Me.TxtCard.SelStart = Len(OverTxt) '让光标停留在最后一位
End Sub



'Private Sub TxtCard_KeyPress(KeyAscii As Integer)
'Dim Char As String
'   Char = Chr(KeyAscii)
'   'KeyAscii = Asc(UCase(Char)) 'UCase只有小写的字母会转成大写；原本大写或非字母之字符保持不变。
''If Not IsNumeric(Char) Then
''    Me.TxtCard.Text = Me.TxtCard.Text
''End If
'
'End Sub



'检测姓名是否输入完毕
Private Sub TxtName_KeyPress(KeyAscii As Integer)
    '   Char = Chr(KeyAscii)
    '   KeyAscii = Asc(UCase(Char))
    Select Case KeyAscii
    Case 13 '回车
        optSex(0).SetFocus '性别选择单选框
    Case Else
    End Select
End Sub

'检测生日选择是否完毕
'当下拉日历被关闭时发生
Private Sub dtpBirthday_CloseUp()
    Me.TxtIDCard.SetFocus '身份证号
End Sub

'检测身份证号是否输入完毕
Private Sub TxtIDCard_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回车
        TxtHandSet.SetFocus '移动电话
    Case Else
    End Select
End Sub
'检测移动电话是否输入完毕
Private Sub TxtHandSet_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回车
        Me.TxtHomeTel.SetFocus '固定电话
    Case Else
    End Select
End Sub
'检测固定电话是否输入完毕
Private Sub TxtHomeTel_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回车
        Me.TxtAddress.SetFocus '住址
    Case Else
    End Select
End Sub
'检测住址是否输入完毕
Private Sub TxtAddress_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回车
        Me.TxtCompany.SetFocus '工作单位
    Case Else
    End Select
End Sub

'检测工作单位是否输入完毕
Private Sub TxtCompany_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回车
        Me.TxtCard.SetFocus '健身卡
    Case Else
    End Select
End Sub

'根据卡的起始时间给箱的起始时间附值
Private Sub dtpStartingTime_CloseUp()
    Me.dtpBoxStarting.Value = Me.dtpStartingTime.Value '箱卡一致
End Sub


'检测健身卡截止日期是否输入完毕
Private Sub dtpDeadline_CloseUp()
    Me.dtpBoxDeadLine.Value = Me.dtpDeadline.Value '箱卡截止时间一致
    Me.TxtChest.SetFocus '保管箱获得交点
End Sub





'验证输入的会员信息
Private Function TestInput() As Boolean
    '对输入的姓名进行验证
    If TxtName.Text = "" Then
        MsgBox "请输入会员姓名！", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    '会员卡号
    If Not IsNumeric(TxtCard.Text) Or Len(TxtCard.Text) <> 5 Then
        MsgBox "请输入会员卡号！会员卡号是由 0-9 中的五位数字组成。", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    '身份证号
    If Not IsNumeric(Me.TxtIDCard.Text) Then
        MsgBox "请输入身份证号", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    TestInput = True
End Function