frmallmodify.frm

健身俱乐部管理系统

         AutoSize        =   -1  'True
         Caption         =   "截止日期"
         Height          =   180
         Left            =   5940
         TabIndex        =   17
         Top             =   4860
         Width           =   720
      End
   End
   Begin XP_Button.XPButton BtnModify 
      Height          =   330
      Left            =   7365
      TabIndex        =   31
      Top             =   5895
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   582
      caption         =   "修改"
   End
   Begin XP_Button.XPButton BtnBack 
      Height          =   330
      Left            =   8520
      TabIndex        =   32
      Top             =   5895
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   582
      caption         =   "返回"
   End
End
Attribute VB_Name = "FrmAllModify"
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 btnBack_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 BtnModify_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 Where  Member.IDCard = '" & FrmAllManage.LvwAll.SelectedItem.Text & "'", CN, adOpenStatic, adLockOptimistic


    Dim Rs_JudgeSame As ADODB.Recordset
    Set Rs_JudgeSame = New ADODB.Recordset
    Rs_JudgeSame.Open "SELECT * FROM Member Where  Member.IDCard <> '" & FrmAllManage.LvwAll.SelectedItem.Text & "'AND Member.IDCard ='" & Me.TxtIDCard.Text & "'", CN
    If Not Rs_JudgeSame.EOF Then
            MsgBox "修改后的身份证号已经存在，不能相同", vbInformation, "提示"
            Exit Sub
    End If
    Rs_JudgeSame.Close
    Set Rs_JudgeSame = Nothing




    '保存会员照片
    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 Card.ID = '" & FrmAllManage.LvwAll.SelectedItem.SubItems(2) & "'", CN, adOpenStatic, adLockOptimistic
    
    If Not Rs_Card.EOF Then
        '该卡在数据库中已经存在
        Rs_Card!Id = Me.TxtCard.Text '卡号
        Rs_Card!UserID = Me.TxtIDCard.Text  '使用者编号(身份证号)
        Rs_Card!StartingTime = Me.dtpStartingTime.Value  '起始时间
        Rs_Card!Deadline = Me.dtpDeadline.Value  '截止时间
        '修改后的卡与以前的不一样
        If Me.TxtCard.Text <> FrmAllManage.LvwAll.SelectedItem.SubItems(2) Then
           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 Chest.UserID ='" & FrmAllManage.LvwAll.SelectedItem.Text & "'", CN, adOpenStatic, adLockOptimistic
    
    If Not Rs_Chest.EOF Then
        '该箱在数据库中已经存在
        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

Private Sub Form_Load()

    '*************读取会员卡信息*****************************
    
    Dim Rs_Card As ADODB.Recordset
    Set Rs_Card = New ADODB.Recordset
    Rs_Card.Open "SELECT * FROM Card Where ID ='" & FrmAllManage.LvwAll.SelectedItem.SubItems(2) & "'", CN, adOpenStatic, adLockOptimistic
    
    If Not Rs_Card.EOF Then
        '该卡在数据库中已经存在
        Me.TxtCard.Text = Rs_Card!Id '卡号
        If Not IsNull(Rs_Card!StartingTime) Then
            Me.dtpStartingTime.Value = Rs_Card!StartingTime  '起始时间
        End If
        If Not IsNull(Rs_Card!Deadline) Then
            Me.dtpDeadline.Value = Rs_Card!Deadline  '截止时间
        End If
    End If
    Rs_Card.Close
    Set Rs_Card = Nothing
    
    '************储物箱**************************
    Dim Rs_Chest As ADODB.Recordset
    Set Rs_Chest = New ADODB.Recordset
    Rs_Chest.Open "SELECT Chest.* FROM Chest Where Chest.UserID ='" & FrmAllManage.LvwAll.SelectedItem.Text & "'", CN, adOpenStatic, adLockOptimistic

    
    If Not Rs_Chest.EOF Then
        '该箱在数据库中已经存在
        Me.TxtChest.Text = Rs_Chest!Id '箱号
        Me.dtpBoxStarting.Value = Rs_Chest!StartingTime  '起始时间
        Me.dtpBoxDeadLine.Value = Rs_Chest!Deadline  '截止时间
    End If
    Rs_Chest.Close
    Set Rs_Chest = Nothing
    
    
    '*************显示会员信息*****************************
    Set Rs_Member = New ADODB.Recordset
    Rs_Member.Open "SELECT Member.* FROM Member Where  Member.IDCard = '" & FrmAllManage.LvwAll.SelectedItem.Text & "'", CN, adOpenStatic, adLockOptimistic

    If Rs_Member.EOF Then
        MsgBox "该卡没有注册", vbInformation, "提示"
        Rs_Member.Close
        Set Rs_Member = Nothing
        Exit Sub
    End If
    '显示会员照片
    
    If Rs_Member!FileLen > 0 Then
        Call MdlPic.PhotoDisplay(Me.ImgPhoto, Rs_Member)
    End If
    
    'Me.TxtCard.Text = Rs_Member!ID '编号(他*拥*有*的第一张卡(正使用中的卡))
    Me.TxtIDCard.Text = Rs_Member!IDCard   '身份证
    Me.TxtName.Text = Rs_Member!Name '姓名
    '性别
    If Rs_Member!Sex = "男" Then
        Me.optSex(0).Value = True '男性
    Else
        Me.optSex(1).Value = True   '女性
    End If
    
    Me.dtpBirthday.Value = Rs_Member!Birthday  '生日
    Me.TxtHandSet.Text = TestNull(Rs_Member!Handset)  '移动电话
    Me.TxtHomeTel.Text = Rs_Member!HomeTel   '固定电话
    Me.TxtAddress.Text = Rs_Member!Address   '住址
    Me.TxtCompany.Text = Rs_Member!Company  '工作单位

    Rs_Member.Close
    Set Rs_Member = Nothing
    
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

'自动滤掉不合格的字符
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