一.显示内容

① 版本信息和标题

Private Sub Form_Load()
    'Major表示主版本号，Minor表示次版本号，Revision表示修订'
    lblVersion.Caption = "Version" & App.Major & "." & App.Minor & "." & App.Revision
    'App.Title返回应用程序的标题，这里显示的是“学生信息管理系统”'
    lblTitle.Caption = App.Title
End Sub

② 查询的内容显示在MsFlexGrid表格控件里

结合判断组合查询中的txtSQL的值

txtSQL = txtSQL & " order by student_ID "    '查询所以满足条件的内容
    Set mrc = ExecuteSQL(txtSQL, MsgText)        '执行查询语句
    '将查询内容显示在表格控件中
    With myflexgrid
        .Rows = 2
        .CellAlignment = 4
        .TextMatrix(1, 0) = "学号"
        .TextMatrix(1, 1) = "姓名"
        .TextMatrix(1, 2) = "性别"
        .TextMatrix(1, 3) = "出生日期"
        .TextMatrix(1, 4) = "班号"
        .TextMatrix(1, 5) = "联系电话"
        .TextMatrix(1, 6) = "入校日期"
        .TextMatrix(1, 7) = "家庭住址"
        '显示数据'判断是否移动到数据集对象的最后一条记录
        Do While Not mrc.EOF
            .Rows = .Rows + 1 '这种方式也可防止空白行的出现'
            .CellAlignment = 4
            .TextMatrix(.Rows - 1, 0) = mrc.Fields(0)
            .TextMatrix(.Rows - 1, 1) = mrc.Fields(1)
            .TextMatrix(.Rows - 1, 2) = mrc.Fields(2)
            .TextMatrix(.Rows - 1, 3) = mrc.Fields(3)
            .TextMatrix(.Rows - 1, 4) = mrc.Fields(4)
            .TextMatrix(.Rows - 1, 5) = mrc.Fields(5)
            .TextMatrix(.Rows - 1, 6) = mrc.Fields(6)
            .TextMatrix(.Rows - 1, 7) = mrc.Fields(7)
            mrc.MoveNext '移动到下一条记录
        Loop
    End With

③ listBox列表框

选择‘所有课程’里的一行，点击向右箭头，选中的数据移动到‘已选择课程’里

'listAllcourse所有课程'
Private Sub listAllcourse_Click()          
'使得选择的“蓝色标记”只位于其中一个list中'
    If listAllcourse.ListIndex <> -1 Then
        listSelectcourse.ListIndex = -1
    End If
End Sub
Private Sub cmdAdd_Click()
    Dim i As Integer         '定义两个整型变量'
    Dim j As Integer
    '往 listSelectcourse列表中添加课程
    If listAllcourse.ListIndex <> -1 Then
       listSelectcourse.AddItem listAllcourse.List(listAllcourse.ListIndex)
    Else
       MsgBox "请先选择课程，再点击添加!", vbOKOnly + vbExclamation, "警告"
    End If
    For i = 0 To listSelectcourse.ListCount - 1             '外循环'
    For j = i + 1 To listSelectcourse.ListCount            '内循环'
    '判断在list列表中是否有相同的数据'
    If listSelectcourse.List(i) = listSelectcourse.List(j) Then
        listSelectcourse.RemoveItem j     '删除添加的数据
        MsgBox "已有添加课程，请先删除再添加！", vbOKOnly, "提示"
        Exit Sub
    End If
    Next j
    Next i
End Sub

选择‘已选择课程’里的一行，点击向左箭头，选中的数据移动到‘所有课程’里

'listSelectcourse已选择课程'
Private Sub listSelectcourse_Click()
    If listSelectcourse.ListIndex <> -1 Then
        listAllcourse.ListIndex = -1
    End If
End Sub
Private Sub cmdDelete_Click()
    '判断是否有内容被选中'
    If listSelectcourse.ListIndex <> -1 Then
       listSelectcourse.RemoveItem listSelectcourse.ListIndex
    Else
       MsgBox "请先选择课程，再点击取消!", vbOKOnly + vbExclamation, "警告"
    End If
End Sub

双击‘所有课程’的一行，取消已选择课程

'双击listBox列表框中的内容在另一个listBox列表框中显示'
Private Sub listAllcourse_DblClick()
    Dim i As Integer         '定义两个整型变量
    Dim j As Integer
    '往 listSelectcourse列表中添加课程
    If listAllcourse.ListIndex <> -1 Then
        listSelectcourse.AddItem listAllcourse.List(listAllcourse.ListIndex)
     For i = 0 To listSelectcourse.ListCount - 1             '外循环
    For j = i + 1 To listSelectcourse.ListCount            '内循环
    '判断在list列表中是否有相同的数据
    If listSelectcourse.List(i) = listSelectcourse.List(j) Then
        listSelectcourse.RemoveItem j     '删除添加的数据
        MsgBox "已有添加课程，请先删除在添加！", vbOKOnly, "提示"
        Exit Sub
 End If
        Next j
        Next i
 End If
End Sub

④ 显示查询记录

Public Sub viewData()
    txtClassno.Text = mrc.Fields(0)
    comboGrade.Text = mrc.Fields(1)
    txtDirector.Text = mrc.Fields(2)
    txtClassroom.Text = mrc.Fields(3)
End Sub

第一条记录

Private Sub firstCommand_Click()
    mrc.MoveFirst    '移动到数据集的第一条记录'
    Call viewData     '调用显示数据的函数'
    If mrc.RecordCount = 1 Then
        MsgBox "只剩下这一条记录了！", vbOKCancel + vbExclamation, "警告"
    End If
End Sub

最后一条记录

Private Sub lastCommand_Click()
    mrc.MoveLast  '移动到数据集的最后一条记录'
    Call viewData      '调用显示数据的函数'
    If mrc.RecordCount = 1 Then
       MsgBox "只剩下这一条记录了！", vbOKCancel + vbExclamation, "警告"
    End If
End Sub

下一条记录

Private Sub nextCommand_Click()
    If mrc.RecordCount = 1 Then
        MsgBox "只剩下这一条记录！", vbOKCancel + vbExclamation, "警告"
    Else
        mrc.MoveNext      '数据集向后移动'
     '判断是否到末位置'
        If mrc.EOF Then
            MsgBox "这已经是最后一条记录了!", vbOKOnly + vbExclamation, "警告"
            mrc.MovePrevious
        End If
    End If
    Call viewData
End Sub

上一条记录

Private Sub previousCommand_Click()
    If mrc.RecordCount = 1 Then
        MsgBox "只剩下这一条记录！", vbOKCancel + vbExclamation, "警告"
    Else
        mrc.MovePrevious   '数据集向前移动'
        If mrc.BOF Then    '判断是否到起始位置'
            MsgBox "这已经是第一条记录了!", vbOKOnly + vbExclamation, "警告"
            mrc.MoveNext
        End If
    End If
    Call viewData
End Sub

⑤ 更、删、改记录

Dim myBookmark As Variant   '书签'
Dim mcclean As Boolean '判断是否处于修改状态'
Private Sub Form_Load()
  txtSQL = "select * from class_Info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.MoveFirst
    Call viewData 'viewData详勘显示查询记录'
    myBookmark = mrc.Bookmark '位置标记'
    mcclean = True
    End If
end sub

更新记录

Private Sub updateCommand_Click()
  '判断是否有重复记录'
    mrc.Delete
    txtSQL = "select * from class_Info where class_No = '" & Trim(txtClassno.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    '判断班号是否重复'
    If mrcc.EOF = False Then
        MsgBox "班号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
        mrcc.Close
        txtClassno.SetFocus
    Else
        mrcc.Close  '关闭连接'
        mrc.AddNew
        mrc.Fields(0) = Trim(txtClassno.Text)
        mrc.Fields(1) = Trim(comboGrade.Text)
        mrc.Fields(2) = Trim(txtDirector.Text)
        mrc.Fields(3) = Trim(txtClassroom.Text)
        mrc.Update  '更新数据库'
        MsgBox "修改班级信息成功！", vbOKOnly + vbExclamation, "警告"
        mrc.Bookmark = myBookmark
        Call viewData
        mcclean = True
    End If
End Sub

取消修改记录

Private Sub cancelCommand_Click()
    If Not mcclean Then
      控件可用
        mrc.Bookmark = myBookmark '回到开始记录位置'
        Call viewData '显示原来的数据'
    Else
        MsgBox "未检测到修改信息", vbOKOnly + vbExclamation, "警告"
    End If
    mcclean = True
End Sub

删除记录

Private Sub deleteCommand_Click()
On Error GoTo P_Err
    myBookmark = mrc.Bookmark '记下当前记录位置
    str2$ = MsgBox("是否删除当前记录？", vbOKOnly + vbExclamation, "删除当前记录")
    If str2$ = vbOK Then     '判断按钮类型
            mrc.MoveNext
            '判断数据集对象是否为空
            If mrc.EOF Then
                mrc.MoveFirst
                myBookmark = mrc.Bookmark
                mrc.MoveLast
                mrc.Delete                '删除记录
                mrc.Bookmark = myBookmark '记载当前记录的位置
                Call viewData             '调用函数显示数据
            Else
                myBookmark = mrc.Bookmark   '记载当前位置
                mrc.MovePrevious
                mrc.Delete
                mrc.Bookmark = myBookmark   '回到原来位置
                Call viewData
            End If
    Else
        mrc.Bookmark = myBookmark
        Call viewData
    End If
p_EXIT:
    Exit Sub
P_Err:
    txtClassno.Text = ""
    comboGrade.Text = ""
    txtDirector.Text = ""
    txtClassroom.Text = ""
    MsgBox "最后一条信息已删除，即将退出!", vbOKOnly + vbCritical, "警告"
    Unload Me
    GoTo p_EXIT
End Sub

修改记录

Private Sub editCommand_Click()
    mcclean = False
    Frame2.Enabled = False
    firstCommand.Enabled = False
    previousCommand.Enabled = False
    nextCommand.Enabled = False
    lastCommand.Enabled = False
    txtClassno.Enabled = True
    comboGrade.Enabled = True
    txtDirector.Enabled = True
    txtClassroom.Enabled = True
    myBookmark = mrc.Bookmark
End Sub

二.限制输入格式

① 下拉框不可输入

Private Sub comboGrade_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

② 只能输入数字

Private Sub txtClassno_KeyPress(KeyAscii As Integer)
 Select Case KeyAscii
          Case 48 To 57 'Ascii=48-57表示数字0-9'
                Exit Sub
          Case 8    'Ascii=8表示退格键'
                Exit Sub
    End Select
    KeyAscii = 0
End Sub

Private Sub txtSID_KeyPress(KeyAscii As Integer)
   If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub

③ 限制数字范围

Private Sub txtResult_LostFocus()
If Val(txtResult.Text) < 0 Or Val(txtResult.Text) > 100 Then
    MsgBox "请输入0-100的数字", vbOKOnly + vbExclamation, "警告"
    txtResult.SetFocus
End If
End Sub

④ 限制输入长度

If Len(txtTel.Text) < 7 Then
    MsgBox "电话号码不能小于7位！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
    txtTel.SetFocus
End If

    If Len(txtUserName.Text) > 15 Then
        txtUserName.Text = Left(txtUserName.Text, 15)'显示前15个字符'
        txtUserName.SelStart = 15'光标在第15个字符处'
    End If

⑤ 只能输入汉字或英文

Private Sub txtDirector_KeyPress(KeyAscii As Integer)
   If KeyAscii < 0 Or KeyAscii = 8 Or KeyAscii = 13 Then
   ElseIf Not Chr(KeyAscii) Like "[a-zA-Z]" Then
   KeyAscii = 0
   End If
End Sub

⑥ 限制输入特殊字符

Private Sub txtcoursedes_KeyPress(KeyAscii As Integer)
 Dim cTemp As String
   cTemp = "`~!@#$%^&*()-=_+[]{};:'\|<>/?.‘“”’、，。——+（）《》？,~·……￥！：；【】" & """ '禁止输入特殊的字符"
  If InStr(1, cTemp, Chr(KeyAscii)) <> 0 Then KeyAscii = 0
End Sub

三.判断

① 判断输入是否为空

    If Not Testtxt(txtCourseno.Text) Then
            MsgBox "请输入课程编号！", vbOKOnly + vbExclamation, "警告"
    End If

    If trim(txtCourseno.Text="") Then
            MsgBox "请输入课程编号！", vbOKOnly + vbExclamation, "警告"
    End If

② 判断两次密码是否一致

    If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
        MsgBox "两次输入密码不一样，请确认！", vbOKOnly + vbExclamation, "警告"
        Text1(1).SetFocus
        Text1(1).Text = ""
        Text1(2).Text = ""
        Exit Sub
    end if

③ 判断输入是否为数字

If Not IsNumeric(Trim(txtSID.Text)) Then
  MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
  Exit Sub
  txtSID.SetFocus
End If

④ 判断用户名是否存在

  UserName = ""   '把变量UserName附成空值'
    If Trim(txtUserName.Text = "") Then '如果没填写用户名，则'
        MsgBox "用户名不能为空，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
        txtUserName.SetFocus    '获得焦点'
    Else    '如果填写用户名'
        txtSQL = "select * from user_Info where user_ID = '" & txtUserName.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF Then
            MsgBox "没有这个用户，请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
            txtUserName.Text=""
            txtUserName.SetFocus
        Else
          MsgBox "用户名存在", vbOKOnly + vbExclamation, "警告"
        end if
    end if

⑤ 判断登陆次数

Public OK As Boolean    '把“OK”定义为公共的逻辑型变量'
Dim miCount As Integer  '记录登录次数'
Private Sub Form_Load()
  OK = False
    miCount = 0             '累计登陆次数清0'
End Sub
Private Sub cmdOK_Click()       '点击确定登录'
    miCount = miCount + 1
    If miCount = 3 Then
        Me.Hide
    End If
    Exit Sub  
End Sub

⑥ 判断数据表是否为空

    txtSQL = "select * from class_Info "   'SQL语句'
    Set mrc = ExecuteSQL(txtSQL, MsgText)    '执行查询操作'
    '判断数据库记录计数是否为空
    If mrc.EOF = False Then
        frmModifyclassinfo.Show
    Else
        str1 = MsgBox("数据为空,无法进入,是否添加班级信息？", vbOKOnly + vbExclamation, "警告")
        If str1 = vbOK Then
        frmAddclassinfo.Show '添加班级信息窗体显示'
    End If
    End If

    txtSQL = "select * from class_Info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.RecordCount = 0 Then     '当前记录集为空'
        MsgBox "暂无班级信息，请先录入", vbOKCancel + vbExclamation, "警告"
    End If

四.连接数据库

① 添加新纪录到数据库

Dim mrc As ADODB.Recordset
Dim txtSQL,MsgText As String
  '查找表class_Info里的所有数据，并放到记录集mrc里'
  txtSQL = "select * from class_Info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(txtClassno.Text)
    mrc.Fields(1) = Trim(comboGrade.Text)
    mrc.Fields(2) = Trim(txtDirector.Text)
    mrc.Fields(3) = Trim(txtClassroom.Text)
    mrc.Update  '更新数据库
    mrc.Close   '关闭数据集对象
    MsgBox "添加班级信息成功！", vbOKOnly + vbExclamation, "添加班级信息"

② 组合查询

Private Sub cmdInquire_Click()
    Dim txtSQL As String
    Dim MsgText As String
    Dim dd(4) As Boolean
    Dim mrc As ADODB.Recordset
    '判断是否选择学号查询方式
    txtSQL = "select * from result_Info where "
    If Check1.Value Then
        If Trim(txtSID.Text) = "" Then
        sMeg = "学号不能为空"
        MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
        txtSID.SetFocus
        Exit Sub
    Else
            '判断输入学号是否为数字
            If Not IsNumeric(Trim(txtSID.Text)) Then
                MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
                Exit Sub
                txtSID.SetFocus
            End If
            dd(0) = True
            txtSQL = txtSQL & "student_ID='" & Trim(txtSID.Text) & "'"
        End If
    End If
    '判断是否选择姓名查询方式
    If Check2.Value Then
        If Trim(txtName.Text) = "" Then
        sMeg = "姓名不能为空"
        MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
        txtName.SetFocus
        Exit Sub
    Else
        dd(1) = True
            If dd(0) Then
                txtSQL = txtSQL & "and student_Name = '" & txtName.Text & "'"
            Else
                txtSQL = txtSQL & "student_Name = '" & txtName.Text & " '"
            End If
        End If
    End If
    '判断是否选择课程查询方式
    If Check3.Value Then
        If Trim(txtCourse.Text) = "" Then
        sMeg = "课程不能为空"
        MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
        txtCourse.SetFocus
        Exit Sub
    Else
        dd(2) = True
            If dd(0) Or dd(1) Then
                txtSQL = txtSQL & "and course_Name = '" & txtCourse.Text & "'"
            Else
                txtSQL = txtSQL & "course_Name = '" & txtCourse.Text & "'"
            End If
        End If
    End If
    If Not (dd(0) Or dd(1) Or dd(2) Or dd(3)) Then
        MsgBox "请设置查询方式！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
    txtSQL = txtSQL & " order by student_ID "    '查询所以满足条件的内容
    Set mrc = ExecuteSQL(txtSQL, MsgText)     '执行查询语句
'    txtSQL = txtSQL & " order by student_ID "
'    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '将查询内容显示在表格控件中
    With myflexgrid
        .Rows = 2
        .CellAlignment = 4
        .TextMatrix(1, 0) = "考试编号"
        .TextMatrix(1, 1) = "学号"
        .TextMatrix(1, 2) = "姓名"
        .TextMatrix(1, 3) = "班号"
        .TextMatrix(1, 4) = "课程名称"
        .TextMatrix(1, 5) = "分数"
        '判断是否移动到数据集对象的最后一条记录
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            .CellAlignment = 4
            .TextMatrix(.Rows - 1, 0) = mrc.Fields(0)
            .TextMatrix(.Rows - 1, 1) = mrc.Fields(1)
            .TextMatrix(.Rows - 1, 2) = mrc.Fields(2)
            .TextMatrix(.Rows - 1, 3) = mrc.Fields(3)
            .TextMatrix(.Rows - 1, 4) = mrc.Fields(4)
            .TextMatrix(.Rows - 1, 5) = mrc.Fields(5)
            mrc.MoveNext
        Loop
    End With
    mrc.Close
End Sub

③ 修改密码

Private Sub cmdOK_Click()
    Dim txtSQL, MsgText As String
    Dim mrc As ADODB.Recordset
    If PassWord = Text1(0).Text Then 'PassWord是一个公共变量，存储着登陆时输入的密码'
        If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
            MsgBox "两次密码输入不一致！", vbOKOnly + vbExclamation, "警告"
            Text1(1).SetFocus
            Text1(1).Text = ""
        Else
            txtSQL = "select * from user_Info where user_ID='" & UserName & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            mrc.Fields(1) = Text1(1).Text
            mrc.Update
            mrc.Close
            MsgBox "密码修改成功！", vbOKOnly + vbExclamation, "修改密码"
            Me.Hide
        End If
     End If
     If PassWord <> Text1(0).Text Then
        MsgBox "原密码输入不正确", vbOKOnly + vbExclamation, "修改密码"
     End If
End Sub

④ 登陆窗体

Sub Main()
    Dim fLogin As New frmLogin  '把fLogin建立为frmLogin窗体的一个新实例
    fLogin.Show vbModal     '显示登录窗体为模式对话框
    'OK为fMainForm类的成员
    If Not fLogin.OK Then '如果fLogin.OK<> true，就结束，并卸载窗体fLogin
        End
    End If
    Unload fLogin
    Set FmainForm = New frmMain ''把FmainForm建立为frmMain窗体的一个新实例
    FmainForm.Show  '显示frmMain窗体
End Sub
Private Sub Form_Load() '登陆窗口加载'
    Dim sBuffer As String   '定义变量sBuffer为字符串类型'
    Dim lSize As Long       '定义变量lSize为长整型'
    sBuffer = Space$(255)                                    '给sBuffer预留255字节的空间，用来填写用户名'
    lSize = Len(sBuffer)                                '把sBuffer字符串长度的值赋给lSize'
    Call GetUserName(sBuffer, lSize)                           '将GetUserName调用到过程里'
    'API中字符串作参数，需要提前确定大小'
    If lSize > 0 Then                       '如果用户名处有字符，则清空；没有就把文本变成vbNullString'
        txtUserName.Text = ""
    Else
        txtUserName.Text = vbNullString
    End If
    OK = False
    miCount = 0             '累计登陆次数清0'
End Sub

⑥ 把数据库里的数据添加到ComboBox组合下拉框中

Private Sub comboGrade_Change()
       Dim mrc As ADODB.Recordset
       Dim txtSQL As String
       Dim MsgText As String
       Dim i As Integer
       listSelectcourse.Clear       '清除列表框内容'
       txtSQL = "select * from gradecourse_Info where grade = '" & comboGrade.Text & "'"     '组合查询语句'
       Set mrc = ExecuteSQL(txtSQL, MsgText)       '执行查询语句'
       '判断是否到最后一条记录'
       If Not mrc.EOF Then
          For i = 1 To mrc.RecordCount
          listSelectcourse.AddItem mrc.Fields(1)      '添加内容到列表框中'
          mrc.MoveFirst      '移动到下一条记录'
     Next i
  End If
  mrc.Close
End Sub

学生信息管理系统——优质代码总结

一.显示内容

① 版本信息和标题

② 查询的内容显示在MsFlexGrid表格控件里

③ listBox列表框

④ 显示查询记录

⑤ 更、删、改记录

二.限制输入格式

① 下拉框不可输入

② 只能输入数字

③ 限制数字范围

④ 限制输入长度

⑤ 只能输入汉字或英文

⑥ 限制输入特殊字符

三.判断

① 判断输入是否为空

② 判断两次密码是否一致

③ 判断输入是否为数字

④ 判断用户名是否存在

⑤ 判断登陆次数

⑥ 判断数据表是否为空

四.连接数据库

① 添加新纪录到数据库

② 组合查询

③ 修改密码

④ 登陆窗体

⑥ 把数据库里的数据添加到ComboBox组合下拉框中

热门文章

最新文章

相关课程

相关电子书

相关实验场景

热门

活动广场

任务中心

开发者评测

高校计划

乘风者计划

训练营

阿里云MVP

话题

直播

下载

镜像站

技术资料

插件

学生信息管理系统——优质代码总结

一.显示内容

① 版本信息和标题

② 查询的内容显示在MsFlexGrid表格控件里

③ listBox列表框

④ 显示查询记录

⑤ 更、删、改记录

二.限制输入格式

① 下拉框不可输入

② 只能输入数字

③ 限制数字范围

④ 限制输入长度

⑤ 只能输入汉字或英文

⑥ 限制输入特殊字符

三.判断

① 判断输入是否为空

② 判断两次密码是否一致

③ 判断输入是否为数字

④ 判断用户名是否存在

⑤ 判断登陆次数

⑥ 判断数据表是否为空

四.连接数据库

① 添加新纪录到数据库

② 组合查询

③ 修改密码

④ 登陆窗体

⑥ 把数据库里的数据添加到ComboBox组合下拉框中

热门文章

最新文章

相关课程

相关电子书

相关实验场景