frminputstudentinfo.frm

Visual basic + sql server2000学员管理系统原代码

        End If
        
         rs![postcode] = Trim(txtPostCode.Text)
        
        .Update
    End With
    
    '清除所有控件的文本显示,DisplayRefresh子程 见本窗体
    DisplayRefresh
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    
ElseIf cmdFlag = 2 Then
    '判断添加的中心代码是否已存在,不存在则退出子程
    strFind = "select * from studentinfo where sname='" & Trim(txtName.Text) & "' and idcard='" & Trim(txtIDCard.Text) & "' "
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '确定是否真要删除记录
    If MsgBox("您确实要删除记录吗？", vbYesNo + vbExclamation, "提示") = vbNo Then
        '调用cmdCancel按钮的click事件
        cmdCancel_Click
        '按钮操作标记恢复为0
        cmdFlag = 0
        '显示当前记录内容,Display子程 见本窗体
        Display
        Exit Sub
    Else
        '删除一条记录
        With rs
            .Delete
            .MovePrevious
            If .EOF Then .MoveLast
            If .BOF Then .MoveFirst
        End With
    End If
    
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
    
ElseIf cmdFlag = 3 Then
    '判断添加的中心代码是否存在,不存在则退出子程
    strFind = "select * from studentinfo where idcard='" & Trim(txtIDCard.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If

    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    '修改一行记录
    With rs
        
        rs![sname] = Trim(txtName.Text)
        rs![pinyin] = Trim(txtPinYin.Text)
        rs![sex] = Trim(cmbSex.Text)
        rs![sid] = Trim(txtSID.Text)
        rs![ccode] = Trim(cmbCCode.Text)
        
        If Trim(txtColleage.Text) = "" Then
            rs![colleage] = "无"
        Else
            rs![colleage] = Trim(txtColleage.Text)
        End If
        
        If Trim(txtMajor.Text) = "" Then
            rs![Major] = "无"
        Else
            rs![Major] = Trim(txtMajor.Text)
        End If
        
        rs![education] = cmbEdu.Text
        
        If Trim(txtWkType.Text) = "" Then
            rs![wktype] = "无"
        Else
              rs![wktype] = Trim(txtWkType.Text)
        End If
        
        rs![wkstatus] = Trim(cmbWkStatus.Text)
        rs![idcard] = Trim(txtIDCard.Text)
        
        If Trim(txtCompany.Text) = "" Then
            rs![company] = "无"
        Else
            rs![company] = Trim(txtCompany.Text)
        End If
        
        If Trim(txtDetails.Text) = "" Then
            rs![details] = "无"
        Else
            rs![details] = Trim(txtDetails.Text)
        End If
        
        If Trim(txtAddress.Text) = "" Then
            rs![mailadd] = "无"
        Else
            rs![mailadd] = Trim(txtAddress.Text)
        End If
        
         rs![postcode] = Trim(txtPostCode.Text)
        
        .Update
        
    End With
    
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
End If

End Sub

Private Sub Form_Activate()

'窗体激活时焦点在cmdAdd上
cmdAdd.SetFocus

Dim ctlcontrol As Control
'设置控件的各种属性,字体大小,对齐类型,清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is Label Then
        ctlcontrol.Alignment = 0
        ctlcontrol.FontSize = 10
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    ElseIf TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
        ctlcontrol.FontSize = 10
    End If
Next

If intUserPermit = 1 Then
    RsClose rs
    '打开表studentinfo,创建记录集
    RsOpen rs, con, "studentinfo", "adcmdtable"
Else
    RsClose rs
    strFind = "select * from studentinfo where ccode='" & strCenterCode & "'"
    '打开表studentinfo,创建记录集
    RsOpen rs, con, strFind, "adcmdtext"
End If

'清除所有控件的文本显示,DisplayRefresh子程 见本窗体
DisplayRefresh

End Sub

Private Sub Form_Load()

'设置窗体的背景色为GetColor函数的返回值,GetColor函数 见模块MdlSystem
Me.BackColor = GetColor
Me.Width = 8500
Me.Height = 4800


'遍历窗体上的所有控件,改变颜色为GetColor函数的返回值(GetColor函数 见模块MdlSystem)
Dim ctlcontrol As Control
For Each ctlcontrol In Controls
    ctlcontrol.BackColor = GetColor
Next


'设置控件的各种属性,字体大小,对齐类型,清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is Label Then
        ctlcontrol.Alignment = 0
        ctlcontrol.FontSize = 10
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    ElseIf TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
        ctlcontrol.FontSize = 10
    End If
Next

If intUserPermit = 1 Then
    RsClose rs
    '打开表studentinfo,创建记录集
    RsOpen rs, con, "studentinfo", "adcmdtable"
Else
    RsClose rs
    strFind = "select * from studentinfo where ccode='" & strCenterCode & "'"
    '打开表studentinfo,创建记录集
    RsOpen rs, con, strFind, "adcmdtext"
End If

'清除所有控件的文本显示,DisplayRefresh子程 见本窗体
DisplayRefresh

'cmdFlag初始值为0
cmdFlag = 0


End Sub

Private Sub DisplayRefresh()

Dim ctlcontrol As Control
'清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is ComboBox Then
        ctlcontrol.Clear
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.Text = ""
    End If
Next

'添加性别
cmbSex.AddItem "男"
cmbSex.AddItem "女"

If intUserPermit = 1 Then
    '从表syscenterinfo中取得所有的中心代码,放入cmbCCode中
    strFind = "select ccode from syscenterinfo"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    Do While (rsTemp.EOF = False)
            cmbCCode.AddItem rsTemp.Fields(0)
            rsTemp.MoveNext
    Loop
    RsClose rsTemp
Else
    '从表syscenterinfo中取得所有的中心代码,放入cmbCCode中
    strFind = "select ccode from syscenterinfo where ccode='" & strCenterCode & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    Do While (rsTemp.EOF = False)
            cmbCCode.AddItem rsTemp.Fields(0)
            rsTemp.MoveNext
    Loop
    RsClose rsTemp
End If

'添加文化程度
cmbEdu.AddItem "初中及以下"
cmbEdu.AddItem "高中"
cmbEdu.AddItem "本科"
cmbEdu.AddItem "硕士"
cmbEdu.AddItem "博士"
cmbEdu.AddItem "博士后"


'添加工作状态
cmbWkStatus.AddItem "在职"
cmbWkStatus.AddItem "在读"
cmbWkStatus.AddItem "无业"


End Sub

'InputVerify函数,当验证输入项均符合要求时,值为True
Private Function InputVerify() As Boolean

Dim intYear As Integer
Dim intMonth As Integer
Dim intDay As Integer
Dim strTemp As String
Dim dateTemp As Date

InputVerify = True

'姓名拼音不能为空,不能多于10个字符
If Len(Trim(txtPinYin.Text)) = 0 Or Len(Trim(txtName.Text)) > 20 Then
    InputVerify = False
     MsgBox "姓名拼音不能为空" & Chr(10) & "不能多于20个字符！", vbOKOnly + vbExclamation, "提示"
End If

'性别不能为空
If Len(Trim(cmbSex.Text)) = 0 Then
    InputVerify = False
    MsgBox "性别不能为空！", vbOKOnly + vbExclamation, "提示"
End If


'中心代码不能为空
If Len(Trim(cmbCCode.Text)) = 0 Then
    InputVerify = False
    MsgBox "中心代码不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'文化程度不能为空
If Len(Trim(cmbEdu.Text)) = 0 Then
    InputVerify = False
    MsgBox "文化程度不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'工作状态不能为空
If Len(Trim(cmbWkStatus.Text)) = 0 Then
    InputVerify = False
    MsgBox "工作状态不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'毕业学校不能多于10个汉字
If Len(Trim(txtColleage.Text)) > 10 Then
    InputVerify = False
    MsgBox "毕业学校不能多于10个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'专业不能多于10个汉字
If Len(Trim(txtMajor.Text)) > 10 Then
    InputVerify = False
    MsgBox "专业不能多于10个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'工作种类不能多于10个汉字
If Len(Trim(txtWkType.Text)) > 10 Then
    InputVerify = False
    MsgBox "工作种类不能多于10个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'工作单位不能多于10个汉字
If Len(Trim(txtCompany.Text)) > 20 Then
    InputVerify = False
    MsgBox "工作单位不能多于20个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'地址不能多于25个汉字
If Len(Trim(txtAddress.Text)) > 25 Then
    InputVerify = False
    MsgBox "地址不能多于25个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'备注不能多于25个汉字
If Len(Trim(txtDetails.Text)) > 25 Then
    InputVerify = False
    MsgBox "备注不能多于25个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'邮政编码必须是6位数字
If Len(Trim(txtPostCode.Text)) <> 6 Then
    InputVerify = False
    MsgBox "邮政编码必须是6位数字！", vbOKOnly + vbExclamation, "提示"
End If

'学号必须是13位数字
If Len(Trim(txtSID.Text)) <> 13 Then
    InputVerify = False
    MsgBox "学号必须是13位数字！", vbOKOnly + vbExclamation, "提示"
Else
    '学号的前三位数字必须是中心代码
    If Mid(txtSID.Text, 1, 3) <> cmbCCode Then
        InputVerify = False
        MsgBox "学号的前三位数字必须是中心代码！", vbOKOnly + vbExclamation, "提示"
    Else
        intYear = Val(Mid(Trim(txtSID.Text), 4, 4))
        intMonth = Val(Mid(Trim(txtSID.Text), 8, 2))
        intDay = Val(Mid(Trim(txtSID.Text), 10, 2))
        strTemp = "" & CStr(intYear) & "/" & CStr(intMonth) & "/" & CStr(intDay) & ""
        '判断学号中的日期值是否正确
        If Not IsDate(strTemp) Then
            InputVerify = False
            MsgBox "学号中的日期错误！", vbOKOnly + vbExclamation, "提示"
        Else
            dateTemp = CDate(strTemp)
            If dateTemp > Now() Then
                InputVerify = False
                MsgBox "学号中的日期错误！", vbOKOnly + vbExclamation, "提示"
            End If
        End If
    End If
End If

'身份证必须是15位或18位数字
If Len(Trim(txtIDCard.Text)) = 18 Or Len(Trim(txtIDCard.Text)) = 15 Then
    '18位时
    If Len(Trim(txtIDCard.Text)) = 18 Then
        intYear = Val(Mid(Trim(txtIDCard.Text), 7, 4))
        intMonth = Val(Mid(Trim(txtIDCard.Text), 11, 2))
        intDay = Val(Mid(Trim(txtIDCard.Text), 13, 2))
        strTemp = "" & CStr(intYear) & "/" & CStr(intMonth) & "/" & CStr(intDay) & ""
        '判断身份证中的日期值是否正确
        If Not IsDate(strTemp) Then
            InputVerify = False
            MsgBox "身份证中的日期错误！", vbOKOnly + vbExclamation, "提示"
            Exit Function
        Else
            dateTemp = CDate(strTemp)
            If dateTemp > Now() Then
                InputVerify = False
                MsgBox "身份证中的日期错误！", vbOKOnly + vbExclamation, "提示"
                Exit Function
            End If
        End If
        
    '15位时
    ElseIf Len(Trim(txtIDCard.Text)) = 15 Then
        intYear = Val(Mid(Trim(txtIDCard.Text), 7, 2))
        intMonth = Val(Mid(Trim(txtIDCard.Text), 9, 2))
        intDay = Val(Mid(Trim(txtIDCard.Text), 11, 2))
        strTemp = "" & CStr(intYear) & "/" & CStr(intMonth) & "/" & CStr(intDay) & ""
        '判断身份证中的日期值是否正确
        If Not IsDate(strTemp) Then
            InputVerify = False
            MsgBox "身份证中的日期错误！", vbOKOnly + vbExclamation, "提示"
            Exit Function
        Else
            dateTemp = CDate(strTemp)
            If dateTemp > Now() Then
                InputVerify = False
                MsgBox "身份证中的日期错误！", vbOKOnly + vbExclamation, "提示"
                Exit Function
            End If
        End If
    
    
    End If
Else
    MsgBox "身份证不能为空" & Chr(13) & "必须是15位数字或18位数字！", vbOKOnly + vbExclamation, "提示"
    Exit Function
End If

End Function

Private Sub Form_LostFocus()
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub

Private Sub Form_Unload(Cancel As Integer)
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub

Private Sub txtIDCard_KeyPress(KeyAscii As Integer)
'只能键入数字和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or KeyAscii > 57 Then
    KeyAscii = 0
    MsgBox "身份证必须是15位数字或18位数字！", vbOKOnly + vbExclamation, "提示"
End If
End Sub

Private Sub txtPinYin_KeyPress(KeyAscii As Integer)
'只能键入字母和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 65) Or (KeyAscii > 90 And KeyAscii < 97) Or (KeyAscii > 122) Then
    KeyAscii = 0
    MsgBox "姓名拼音必须是英文字符！", vbOKOnly + vbExclamation, "提示"
End If
End Sub

Private Sub txtPostCode_KeyPress(KeyAscii As Integer)
'只能键入数字和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or KeyAscii > 57 Then
    KeyAscii = 0
    MsgBox "邮政代码必须是六位数字！", vbOKOnly + vbExclamation, "提示"
End If
End Sub

Private Sub txtSID_KeyPress(KeyAscii As Integer)
'只能键入数字和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or KeyAscii > 57 Then
    KeyAscii = 0
    MsgBox "学号必须是13位数字！", vbOKOnly + vbExclamation, "提示"
End If
End Sub


Private Sub Display()

txtName.Text = rs!sname
txtPinYin.Text = rs!pinyin
cmbSex.Text = rs!sex
txtSID.Text = rs!sid
cmbCCode.Text = rs!ccode
txtColleage.Text = rs!colleage
txtMajor.Text = rs!Major
cmbEdu.Text = rs!education
txtWkType.Text = rs!wktype
cmbWkStatus.Text = rs!wkstatus
txtIDCard.Text = rs!idcard
txtCompany.Text = rs!company
txtDetails.Text = rs!details
txtAddress.Text = rs!mailadd
txtPostCode.Text = rs!postcode

End Sub

Private Sub ControlEnabled()

'消除控件的禁用
Dim ctlEnabled As Control
For Each ctlEnabled In Controls
    ctlEnabled.Enabled = True
Next

End Sub

Private Sub ControlDisabled()

'禁用控件文本框和组合框
Dim ctlDisabled As Control
For Each ctlDisabled In Controls
    If TypeOf ctlDisabled Is TextBox Or TypeOf ctlDisabled Is ComboBox Then
            ctlDisabled.Enabled = False
    End If
Next

End Sub