_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 '會(huì)員

Dim OpenFileName As String

Private Sub BtnCancel_Click()
    Unload Me
End Sub

Private Sub btnPhoto_Click()

    On Error Resume Next
    dlgPic.CancelError = True '返回或設(shè)置一個(gè)值，該值指示當(dāng)選取“取消”按鈕時(shí)是否出錯(cuò)
    dlgPic.FileName = ""
    dlgPic.Filter = "圖片(*.*)|*.*"   '& vbCrLf & "圖片(*.jpg)|*.jpg"     '設(shè)置保存類型
    dlgPic.ShowOpen

    OpenFileName = dlgPic.FileName
    Me.ImgPhoto.Picture = LoadPicture(OpenFileName)
    If Err = 481 Then
        MsgBox "您選擇的文件不是圖片或該圖片類型不能識(shí)別", 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 方法會(huì)失敗
    TxtName.SetFocus '輸入姓名文本框獲得焦點(diǎn)
    '時(shí)間選擇控件初始化
    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 '數(shù)據(jù)庫連接


    
End Sub
'保存信息
Private Sub BtnSave_Click()
    Dim Flag_test As Boolean
    '驗(yàn)證輸入的會(huì)員信息
    Flag_test = TestInput
    If Flag_test = False Then
        Exit Sub
    End If
    
    '*************保存會(huì)員信息*****************************
    Set Rs_Member = New ADODB.Recordset
    Rs_Member.Open "SELECT * FROM Member", CN, adOpenStatic, adLockOptimistic
    Rs_Member.AddNew

    '保存會(huì)員照片
    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 '會(huì)員卡
    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 '移動(dòng)電話
    Rs_Member!HomeTel = Me.TxtHomeTel.Text   '固定電話
    Rs_Member!Address = Me.TxtAddress.Text   '住址
    Rs_Member!Company = Me.TxtCompany.Text  '工作單位

    '*************保存會(huì)員卡信息*****************************
    
    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
        '判斷該會(huì)員卡是否過期
        If DateDiff("d", Now, Rs_Card!Deadline) >= 0 Then
            MsgBox "該會(huì)員卡尚未過期,請(qǐng)重新填寫！"
            Me.TxtCard.Text = ""
            Exit Sub '退出
        Else
    
            '該卡在數(shù)據(jù)庫中已經(jīng)存在,但已經(jīng)過期
            Rs_Card!UserID = Me.TxtIDCard.Text  '使用者編號(hào)(身份證號(hào))
            Rs_Card!StartingTime = Me.dtpStartingTime.Value  '起始時(shí)間
            Rs_Card!Deadline = Me.dtpDeadline.Value  '截止時(shí)間
            Rs_Card!InOutTimes = 0 '使用次數(shù)
        End If
    
    Else
        '新卡
        Rs_Card.AddNew
        
        Rs_Card!Id = Me.TxtCard.Text '卡號(hào)
        Rs_Card!UserID = Me.TxtIDCard.Text  '使用者編號(hào)
        Rs_Card!StartingTime = Me.dtpStartingTime.Value  '起始時(shí)間
        Rs_Card!Deadline = Me.dtpDeadline.Value  '截止時(shí)間
        Rs_Card!InOutTimes = 0 '使用次數(shù)
      
    End If

    
    '************儲(chǔ)物箱**************************
    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
        '判斷該箱是否已經(jīng)在使用中(刨除箱號(hào)為空的情況)
        If DateDiff("d", Now, Rs_Chest!Deadline) >= 0 And Me.TxtChest.Text <> "" Then
            MsgBox "該儲(chǔ)物箱正在使用中,請(qǐng)重新填寫！"
            Me.TxtChest.Text = ""
            Exit Sub '退出
        End If
    
        '該箱在數(shù)據(jù)庫中已經(jīng)存在
        Rs_Chest!Id = Me.TxtChest.Text '箱號(hào)
        Rs_Chest!UserID = Me.TxtIDCard.Text  '使用者編號(hào)(身份證號(hào))
        Rs_Chest!StartingTime = Me.dtpBoxStarting.Value '起始時(shí)間
        Rs_Chest!Deadline = Me.dtpBoxDeadLine.Value  '截止時(shí)間

    Else
        '新箱
        Rs_Chest.AddNew
        Rs_Chest!Id = Me.TxtChest.Text '箱號(hào)
        Rs_Chest!UserID = Me.TxtIDCard.Text '使用者編號(hào)(身份證號(hào))
        Rs_Chest!StartingTime = Me.dtpBoxStarting.Value  '起始時(shí)間
        Rs_Chest!Deadline = Me.dtpBoxDeadLine.Value  '截止時(shí)間

    End If

    '如果都正常就保存該信息
    Rs_Member.Update
    Rs_Member.Close
    Set Rs_Member = Nothing
    
    '會(huì)員卡
    Rs_Card.Update
    Rs_Card.Close
    Set Rs_Card = Nothing
    
    '儲(chǔ)物箱
    Rs_Chest.Update
    Rs_Chest.Close
    Set Rs_Chest = Nothing

    MsgBox "新會(huì)員注冊(cè)成功"
    Unload Me
End Sub

'Option Explicit







Private Sub SSTab1_DblClick()

End Sub


'自動(dòng)濾掉不合格的字符
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) '讓光標(biāo)停留在最后一位
End Sub



'Private Sub TxtCard_KeyPress(KeyAscii As Integer)
'Dim Char As String
'   Char = Chr(KeyAscii)
'   'KeyAscii = Asc(UCase(Char)) 'UCase只有小寫的字母會(huì)轉(zhuǎn)成大寫；原本大寫或非字母之字符保持不變。
''If Not IsNumeric(Char) Then
''    Me.TxtCard.Text = Me.TxtCard.Text
''End If
'
'End Sub



'檢測(cè)姓名是否輸入完畢
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

'檢測(cè)生日選擇是否完畢
'當(dāng)下拉日歷被關(guān)閉時(shí)發(fā)生
Private Sub dtpBirthday_CloseUp()
    Me.TxtIDCard.SetFocus '身份證號(hào)
End Sub

'檢測(cè)身份證號(hào)是否輸入完畢
Private Sub TxtIDCard_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回車
        TxtHandSet.SetFocus '移動(dòng)電話
    Case Else
    End Select
End Sub
'檢測(cè)移動(dòng)電話是否輸入完畢
Private Sub TxtHandSet_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回車
        Me.TxtHomeTel.SetFocus '固定電話
    Case Else
    End Select
End Sub
'檢測(cè)固定電話是否輸入完畢
Private Sub TxtHomeTel_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回車
        Me.TxtAddress.SetFocus '住址
    Case Else
    End Select
End Sub
'檢測(cè)住址是否輸入完畢
Private Sub TxtAddress_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回車
        Me.TxtCompany.SetFocus '工作單位
    Case Else
    End Select
End Sub

'檢測(cè)工作單位是否輸入完畢
Private Sub TxtCompany_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13 '回車
        Me.TxtCard.SetFocus '健身卡
    Case Else
    End Select
End Sub

'根據(jù)卡的起始時(shí)間給箱的起始時(shí)間附值
Private Sub dtpStartingTime_CloseUp()
    Me.dtpBoxStarting.Value = Me.dtpStartingTime.Value '箱卡一致
End Sub


'檢測(cè)健身卡截止日期是否輸入完畢
Private Sub dtpDeadline_CloseUp()
    Me.dtpBoxDeadLine.Value = Me.dtpDeadline.Value '箱卡截止時(shí)間一致
    Me.TxtChest.SetFocus '保管箱獲得交點(diǎn)
End Sub





'驗(yàn)證輸入的會(huì)員信息
Private Function TestInput() As Boolean
    '對(duì)輸入的姓名進(jìn)行驗(yàn)證
    If TxtName.Text = "" Then
        MsgBox "請(qǐng)輸入會(huì)員姓名！", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    '會(huì)員卡號(hào)
    If Not IsNumeric(TxtCard.Text) Or Len(TxtCard.Text) <> 5 Then
        MsgBox "請(qǐng)輸入會(huì)員卡號(hào)！會(huì)員卡號(hào)是由 0-9 中的五位數(shù)字組成。", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    '身份證號(hào)
    If Not IsNumeric(Me.TxtIDCard.Text) Then
        MsgBox "請(qǐng)輸入身份證號(hào)", vbInformation, "提示"
        TestInput = False
        Exit Function
    End If
    TestInput = True
End Function