frmedithistory.frm

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

        rs![bcode] = Trim(txtBCode.Text)
        rs![Status] = Trim(cmbStatus.Text)
        rs![ccode] = Trim(cmbCCode.Text)
        rs![idcard] = strIdCard
        rs![jdate] = DTPDate.Value
        
        .Update
    End With
    
    '清除所有控件的文本显示,DisplayRefresh子程 见本窗体
    DisplayRefresh
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    
ElseIf cmdFlag = 2 Then
    
    '确定是否真要删除记录
    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

    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    '修改一行记录
    With rs
        
         rs![sname] = Trim(cmbName.Text)
        rs![sid] = Trim(txtSID.Text)
        rs![smcode] = Trim(cmbSMCode.Text)
        rs![bcode] = Trim(txtBCode.Text)
        rs![Status] = Trim(cmbStatus.Text)
        rs![ccode] = Trim(cmbCCode.Text)
        rs![idcard] = strIdCard
        rs![jdate] = DTPDate.Value
        
        .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
    ElseIf TypeOf ctlcontrol Is CommandButton Then
        ctlcontrol.FontSize = 10
    End If
Next

If intUserPermit = 1 Then
    RsClose rs
    '打开表studentinfo,创建记录集
    RsOpen rs, con, "studenthistory", "adcmdtable"
Else
    RsClose rs
    strFind = "select * from studenthistory 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 = 6700
Me.Height = 3700

'遍历窗体上的所有控件,改变颜色为GetColor函数的返回值(GetColor函数 见模块MdlSystem)
Dim ctlcontrol As Control
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is DTPicker Then
        ctlcontrol.CalendarBackColor = GetColor
        ctlcontrol.CalendarTitleBackColor = GetColor
    Else
        ctlcontrol.BackColor = GetColor
        
    End If
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
    ElseIf TypeOf ctlcontrol Is CommandButton Then
        ctlcontrol.FontSize = 10
    End If
Next

If intUserPermit = 1 Then
    RsClose rs
    '打开表studentinfo,创建记录集
    RsOpen rs, con, "studenthistory", "adcmdtable"
Else
    RsClose rs
    strFind = "select * from studenthistory 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.FontSize = 10
        ctlcontrol.Text = ""
    End If
Next

'填充学员状态组合框
cmbStatus.AddItem "休学"
cmbStatus.AddItem "在读"
cmbStatus.AddItem "已获认证"
cmbStatus.AddItem "毕业未获证"

'填充学期代号组合框
cmbSMCode.AddItem "S1"
cmbSMCode.AddItem "S2"
cmbSMCode.AddItem "Y2"

'DTP的默认值
DTPDate.Value = Now()

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

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

End Sub

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 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
Private Sub Display()

txtSID.Text = rs!sid
cmbName.Text = rs!sname
cmbSMCode.Text = rs!smcode
txtBCode.Text = rs!bcode
cmbStatus.Text = rs!Status
cmbCCode.Text = rs!ccode
DTPDate.Value = rs!jdate

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

'学号必须是13位数字
If Len(Trim(txtSID.Text)) <> 13 Then
    InputVerify = False
    MsgBox "学号必须是13位数字！", vbOKOnly + vbExclamation, "提示"
Else
    '学号的前三位数字必须是中心代码
    If Mid(txtSID.Text, 1, 3) <> cmbCCode.Text 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

'学期代号不能为空
If (Trim(cmbSMCode.Text)) = 0 Then
    InputVerify = False
    MsgBox "学期代号不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'班号不能为空,不能大于4个字符
If Len(Trim(txtBCode.Text)) <> 4 Then
    InputVerify = False
    MsgBox "班号不能为空" & Chr(13) & "不能大于4个字符！", vbOKOnly + vbExclamation, "提示"
Else
    If StrComp(Mid(Trim(txtBCode.Text), 1, 1), "S") = 0 Or StrComp(Mid(Trim(txtBCode.Text), 1, 1), "Y") = 0 Then
        If Not IsNumeric(Mid(Trim(txtBCode.Text), 2, 3)) Then
            InputVerify = False
            MsgBox "班号后三个字符必须数字！", vbOKOnly + vbExclamation, "提示"
        End If
    Else
        InputVerify = False
        MsgBox "班号第一个字符必须是S或Y！", vbOKOnly + vbExclamation, "提示"
    End If
End If

'学期代号不能为空
If Len(Trim(cmbSMCode.Text)) = 0 Then
    InputVerify = False
    MsgBox "学期代号不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'学员状态不能为空
If Len(Trim(cmbStatus.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(cmbName.Text)) = 0 Then
    InputVerify = False
    MsgBox "姓名不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'日期不能大于现在
If (DTPDate.Value) > Now() Then
    InputVerify = False
    MsgBox "日期不能为空" & Chr(13) & "不能大于现在！", vbOKOnly + vbExclamation, "提示"
End If

End Function