frmshowstu.frm

一个招生考试系统,有比较完整的功能 VB+Access桌面型的应用

         Width           =   735
      End
   End
   Begin VB.Label Label9 
      Caption         =   "Label9"
      Height          =   255
      Index           =   3
      Left            =   6120
      TabIndex        =   31
      Top             =   1920
      Width           =   495
   End
End
Attribute VB_Name = "frmShowStu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'定义多个ADODB.Recordset窗体范围内变量
Dim rs_zhuanye As New ADODB.Recordset
Dim rs_Stu As New ADODB.Recordset
Dim rs_Grade As New ADODB.Recordset
Dim rs_Admit As New ADODB.Recordset  '用于打开已录取考生表
Dim rs_check0 As New ADODB.Recordset
Dim rs_check As New ADODB.Recordset  '用于检测是否已招满
Dim rs_check2 As New ADODB.Recordset  '用于检测是否已招满


Private Sub cmdAdmit_Click()
   '先判断是否填入了录取院系信息
   If txtDept.Text = "" Then
      MsgBox "请输入录取专业信息！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   End If
   '检测该考生是否已被录取
  
   Dim sqlcheck1 As String
   sqlcheck1 = "select * from 招生计划表 where 专业='" & txtDept.Text _
   & "'"
   Dim rs_zhuanye As New ADODB.Recordset
   rs_zhuanye.Open sqlcheck1, conn, adOpenStatic, adLockOptimistic
   If rs_zhuanye.EOF = True Then
    MsgBox "该专业不存在，不能录取！", vbOKOnly + vbInformation, ""
      rs_zhuanye.Close
      Exit Sub
   End If
   
   Dim sqlCheck0 As String
   sqlCheck0 = "select * from 已录取考生表 where 准考证号=" & Text1(0).Text
   rs_check0.Open sqlCheck0, conn, adOpenStatic, adLockOptimistic
   If rs_check0.EOF = False Then
      MsgBox "该生已被录取过，不能再录取！", vbOKOnly + vbInformation, ""
      rs_check0.Close
      Exit Sub
   End If
   rs_check0.Close
   '检测招生计划表中该院系在该省招生名额是否已满
   '先求招生计划中该院系在该省招生名额
   Dim sqlcheck As String
   sqlcheck = "select * from 招生计划表 where 专业= '" & txtDept.Text _
   & "'"
   rs_check.CursorLocation = adUseClient
   rs_check.Open sqlcheck, conn, adOpenStatic, adLockOptimistic
   '如果该院系在该省不招生，则提示用户并退出
   Dim sumPlan As Integer
   sumPlan = rs_check.Fields(1)  '招生计划中该院系在该省招生名额
   rs_check.Close
   
   '再求已录取考生表中该院系在该省已录取人数
   Dim sqlCheck2 As String
   sqlCheck2 = "select count(准考证号) as 已招人数 from 已录取考生表 where 专业= '" _
   & txtDept.Text & "'"
   rs_check2.CursorLocation = adUseClient
   rs_check2.Open sqlCheck2, conn, adOpenStatic, adLockOptimistic
   Dim sumAdmit As Integer
   If rs_check2.EOF = True Then
      sumAdmit = 0
   Else
      sumAdmit = rs_check2.Fields(0)  '已录取考生表中该院系在该省招生人数
   End If
   rs_check2.Close
   '检测是否名额已满
   If (sumPlan - sumAdmit) = 0 Then
       MsgBox "该专业录取名额已满，无法再录取！", vbOKOnly + vbInformation, "注意"
       Exit Sub
   End If
   
   '录取前提示用户是否确实录取
   Dim answer As String
   answer = MsgBox("确定要录取吗？", vbYesNo, "")
   '确实删除
   If answer = vbYes Then
      Dim sqlAdmit As String
      sqlAdmit = "select * from 已录取考生表"
      rs_Admit.Open sqlAdmit, conn, adOpenStatic, adLockPessimistic
      rs_Admit.AddNew
      rs_Admit.Fields(0) = Text1(0).Text
      rs_Admit.Fields(1) = Text1(1).Text
      rs_Admit.Fields(2) = txtDept.Text
      rs_Admit.Fields(3) = Text8(5).Text
      '更新记录后关闭它
      rs_Admit.Update
      rs_Admit.Close
      '提示用户录取成功
      MsgBox "录取成功！", vbOKOnly + vbInformation, ""
   Else
      Exit Sub
   End If
   
End Sub

Private Sub cmdAfterward_Click()
   '先移动rs_Stu记录到后一条
   rs_Stu.MoveNext
   
   '设置前一条和第一条按钮可用
   cmdForward.Enabled = True
   cmdFirst.Enabled = True
   '如果已经是最后一条记录，则提示用户
   If rs_Stu.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“后一条”和最后一条按钮不可用
      cmdAfterward.Enabled = False
      cmdLast.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到后一条记录，并且显示之
   Else
      For i = 0 To 7
         Text1(i).Text = rs_Stu.Fields(i)
      Next i
      '移动其他各表游标到该记录并显示
      rs_Grade.MoveNext
      For i = 0 To 7
         Text8(i).Text = rs_Grade.Fields(i + 2)
      Next i
    '  rs_Wish.MoveNext
      
         
   End If
End Sub

Private Sub cmdChange_Click()
   If cmdChange.Caption = "修   改" Then
      '设置相应的按钮不可用
      cmdDel.Enabled = False
      '设置修改按钮为确定按钮
      cmdChange.Caption = "确   定"
      '设置各个textbox控件可写
      For i = 0 To 7
         Text1(i).Enabled = True
      Next i
      For i = 0 To 7
         Text8(i).Enabled = True
      Next i
      
   ElseIf cmdChange.Caption = "确   定" Then
      '设置修改、删除按钮可用
   cmdChange.Enabled = True
   cmdDel.Enabled = True
   cmdChange.Caption = "修   改"
   '如果单科分数改动，则需要修改总分
   '计算总成绩
   Dim sum As Integer
   sum = 0
   For i = 0 To 4
      sum = sum + Val(Text8(i).Text)
   Next i
   '总分等于各科分数之和
   Text8(5).Text = sum
   
   rs_Grade.Update
   
   '保存了修改结果之后，需要使各个TextBox控件设为不可写
      For i = 0 To 7
         Text1(i).Enabled = False
      Next i
      For i = 0 To 7
         Text8(i).Enabled = False
      Next i
      
   End If
End Sub

Private Sub cmdDel_Click()
   '当单击删除记录时，需要弹出一个提示框，警告用户
   Dim answer As String
   answer = MsgBox("确定要删除吗？", vbYesNo, "")
   '确实删除
   If answer = vbYes Then
      rs_Stu.Delete  '删除当前记录
      rs_Stu.Update  '更新删除
      rs_Grade.Delete
      rs_Grade.Update
      MsgBox "成功删除！", vbOKOnly + vbExclamation, ""
      '设置删除按钮不可用
      cmdDel.Enabled = False
   Else
       Exit Sub
   End If
   '删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
   '先移动rs_Stu记录到后一条
   rs_Stu.MoveNext
   rs_Grade.MoveNext
   
   
   If rs_Stu.EOF Then
     rs_Stu.MoveLast
     rs_Grade.MoveLast
     
   End If
      For i = 0 To 7
         Text1(i).Text = rs_Stu.Fields(i)
      Next i
      For i = 0 To 7
         Text8(i).Text = rs_Grade.Fields(i + 2)
      Next i
     
     
End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub

Private Sub cmdFirst_Click()
   '先移动rs_Stu记录到第一条
   rs_Stu.MoveFirst
   '同时需要设置相应按钮为不可用和不可用
   cmdForward.Enabled = False
   cmdFirst.Enabled = False
   cmdAfterward.Enabled = True
   cmdLast.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_Stu.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   '如果不是，则个数据表的记录位置移到第一条记录，并且显示之
   Else
      For i = 0 To 7
         Text1(i).Text = rs_Stu.Fields(i)
      Next i
      '移动其他各表游标到该记录并显示
      rs_Grade.MoveFirst
      For i = 0 To 7
         Text8(i).Text = rs_Grade.Fields(i + 2)
      Next i
     
      
   End If
End Sub

Private Sub cmdForward_Click()
   '先移动rs_Stu记录到前一条
   rs_Stu.MovePrevious
   rs_Grade.MovePrevious
   '设置后一条和最后一条按钮可用
   cmdAfterward.Enabled = True
   cmdLast.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_Stu.BOF = True Or rs_Grade.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“前一条”和第一条按钮不可用
      cmdForward.Enabled = False
      cmdFirst.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到前一条记录，并且显示之
   Else
      For i = 0 To 7
         Text1(i).Text = rs_Stu.Fields(i)
      Next i
      '移动其他各表游标到该记录并显示
'      rs_Grade.MovePrevious
      For i = 0 To 7
         Text8(i).Text = rs_Grade.Fields(i + 2)
      Next i
       
                  
   End If
End Sub

Private Sub cmdLast_Click()
   '先移动rs_Stu记录到最后一条
   rs_Stu.MoveLast
   '同时需要设置后一条和最后一条按钮不可用,第一条和前一条按钮可用
   cmdAfterward.Enabled = False
   cmdLast.Enabled = False
   cmdFirst.Enabled = True
   cmdForward.Enabled = True
   '如果已经是最后一条记录，则提示用户
   If rs_Stu.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      
      Exit Sub
   '如果不是，则个数据表的记录位置移到最后一条记录，并且显示之
   Else
      For i = 0 To 7
         Text1(i).Text = rs_Stu.Fields(i)
      Next i
      '移动其他各表游标到该记录并显示
      rs_Grade.MoveLast
      For i = 0 To 7
         Text8(i).Text = rs_Grade.Fields(i + 2)
      Next i
    
      
              
   End If
End Sub

Private Sub cmdQuery_Click()
   Dim Markstu As String
   Dim strInput As String  '用于保存用户输入的考生准考证号
   Dim lonInput As Long   '用于保存转换成数字后的考生准考证号
   strInput = InputBox("请输入要查询的考生准考证号：", "输入准考证号")
   If Len(strInput) = 0 Then
      MsgBox "没有输入准考证号，取消查询！", vbOKOnly + vbInformation, "注意"
   Else
      lonInput = Val(strInput)
      Markstu = rs_Stu.Bookmark
           
      '使用find 方法查找记录
      rs_Stu.Find "准考证号 like '" & lonInput & "'"
      '如果没有找到则提示用户
      If rs_Stu.EOF Then
         MsgBox "对不起，没有找到你所要的记录！", vbOKOnly + vbInformation, "注意"
         Exit Sub
      Else
      '如果找到则显示该记录并且相应各表游标都移到该记录
         For i = 0 To 7
            Text1(i).Text = rs_Stu.Fields(i)
         Next i
         '移动其他各表游标到该记录并显示
         rs_Grade.Find "准考证号 like '" & lonInput & "'"
         For i = 0 To 7
            Text8(i).Text = rs_Grade.Fields(i + 2)
         Next i
         
         
      End If
            
   End If
End Sub

Private Sub Form_Load()
   Dim X0 As Long
   Dim Y0 As Long
   '让窗体居中
   X0 = Screen.Width
   Y0 = Screen.Height
   X0 = (X0 - Me.Width) / 2
   Y0 = (Y0 - Me.Height) / 2
   Me.Move X0, Y0
   
   Dim sql_Stu As String
   Dim sql_Grade As String
   Dim sql_Wish As String
   Dim sql_Study As String
   Dim sql_Relation As String
   Dim i As Integer
   
   '在from_laod（)方法中打开5个考生信息表
   sql_Stu = "select * from 考生基本信息表"
   rs_Stu.CursorLocation = adUseClient
   rs_Stu.Open sql_Stu, conn, adOpenStatic, adLockOptimistic
   For i = 0 To 7
      Text1(i).Text = rs_Stu.Fields(i)
   Next i
   
   sql_Grade = "select * from 考生成绩表"
   rs_Grade.CursorLocation = adUseClient
   rs_Grade.Open sql_Grade, conn, adOpenStatic, adLockOptimistic
   For i = 0 To 7
      Text8(i).Text = rs_Grade.Fields(i + 2)
   Next i
   
  
   '下面需要设置各个textbox控件不可修改
      For i = 0 To 7
         Text1(i).Enabled = False
      Next i
      For i = 0 To 7
         Text8(i).Enabled = False
      Next i
     
 
End Sub
Private Sub Form_Unload(Cancel As Integer)
   rs_Stu.Close
   rs_Grade.Close
   
End Sub