📄 frmshowstuinfor.frm
字号:
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 7800
TabIndex = 20
Top = 360
Width = 495
End
Begin VB.Label Label9
BackColor = &H0000FFFF&
Caption = "外语"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5280
TabIndex = 18
Top = 360
Width = 615
End
Begin VB.Label Label8
BackColor = &H0000FFFF&
Caption = "数学"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3000
TabIndex = 16
Top = 360
Width = 735
End
Begin VB.Label Label7
BackColor = &H0000FFFF&
Caption = "语文"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 600
TabIndex = 14
Top = 360
Width = 735
End
End
Begin VB.Frame Frame1
BackColor = &H0000FFFF&
Caption = "志愿信息"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 120
TabIndex = 0
Top = 120
Width = 9975
Begin VB.TextBox Text1
Height = 375
Index = 5
Left = 7320
TabIndex = 12
Top = 720
Width = 2175
End
Begin VB.TextBox Text1
Height = 375
Index = 4
Left = 4440
TabIndex = 10
Top = 720
Width = 1815
End
Begin VB.TextBox Text1
Height = 375
Index = 3
Left = 1320
TabIndex = 8
Top = 720
Width = 1935
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 7320
TabIndex = 6
Top = 240
Width = 2175
End
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 4440
TabIndex = 4
Top = 240
Width = 1815
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 1320
TabIndex = 2
Top = 240
Width = 1935
End
Begin VB.Label Label6
BackColor = &H0000FFFF&
Caption = "本校院系三"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6240
TabIndex = 11
Top = 840
Width = 1095
End
Begin VB.Label Label5
BackColor = &H0000FFFF&
Caption = "本校院系二"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3360
TabIndex = 9
Top = 840
Width = 1215
End
Begin VB.Label Label4
BackColor = &H0000FFFF&
Caption = "本校院系一"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 7
Top = 840
Width = 1215
End
Begin VB.Label Label3
BackColor = &H0000FFFF&
Caption = "第三志愿"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6360
TabIndex = 5
Top = 360
Width = 975
End
Begin VB.Label Label2
BackColor = &H0000FFFF&
Caption = "第二志愿"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3360
TabIndex = 3
Top = 360
Width = 975
End
Begin VB.Label Label1
BackColor = &H0000FFFF&
Caption = "第一志愿"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 1
Top = 360
Width = 855
End
End
End
Attribute VB_Name = "FrmShowStuInfor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义多个ADODB.Recordset窗体范围内变量
Dim rs_Stu As New ADODB.Recordset
Dim rs_Grade As New ADODB.Recordset
Dim rs_Wish As New ADODB.Recordset
Dim rs_Study As New ADODB.Recordset
Dim rs_Relation 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 '用于检测是否已招满
Public MyConnection As ADODB.Connection
Public ConString As String
Private Sub cmdAdmit_Click()
'先判断是否填入了录取Colleges信息
If txtDept.Text = "" Then
MsgBox "请输入录取Colleges信息！", vbOKOnly + vbInformation, "注意"
Exit Sub
End If
'检测该考生是否已被录取
Dim sqlCheck0 As String
sqlCheck0 = "select * from StuAdmission where CandidatesID=" & Text3(0).Text
rs_check0.Open sqlCheck0, MyConnection, adOpenStatic, adLockOptimistic
If rs_check0.EOF = False Then
MsgBox "该生已被录取过，不能再录取！", vbOKOnly + vbInformation, ""
rs_check0.Close
Exit Sub
End If
rs_check0.Close
'检测招生计划表中该Colleges在该省招生名额是否已满
'先求招生计划中该Colleges在该省招生名额
Dim sqlCheck As String
sqlCheck = "select * from StuAdmissionScheme where Colleges= '" & txtDept.Text _
& "' and Provinces='" & Text3(5) & "'"
rs_check.CursorLocation = adUseClient
rs_check.Open sqlCheck, MyConnection, adOpenStatic, adLockOptimistic
'如果该Colleges在该省不招生，则提示用户并退出
If rs_check.EOF = True Then
MsgBox "对不起，该Colleges在该省不招生！", vbOKOnly + vbInformation, "注意"
rs_check.Close
Exit Sub
End If
Dim sumPlan As Integer
sumPlan = rs_check.Fields(2) '招生计划中该Colleges在该省招生名额
rs_check.Close
'再求已录取考生表中该Colleges在该省已录取人数
Dim sqlCheck2 As String
sqlCheck2 = "select count(CandidatesID) as 已招人数 from StuAdmission where Colleges= '" _
& txtDept.Text & "' and Provinces='" & Text3(5) & "'"
rs_check2.CursorLocation = adUseClient
rs_check2.Open sqlCheck2, MyConnection, adOpenStatic, adLockOptimistic
Dim sumAdmit As Integer
If rs_check2.EOF = True Then
sumAdmit = 0
Else
sumAdmit = rs_check2.Fields(0) '已录取考生表中该Colleges在该省招生人数
End If
rs_check2.Close
'检测是否名额已满
If (sumPlan - sumAdmit) = 0 Then
MsgBox "该Colleges在该省录取名额已满，无法再录取！", vbOKOnly + vbInformation, "注意"
Exit Sub
End If
'录取前提示用户是否确实录取
Dim answer As String
answer = MsgBox("确定要录取吗？", vbYesNo, "")
'确实删除
If answer = vbYes Then
Dim sqlAdmit As String
sqlAdmit = "select * from StuAdmission"
rs_Admit.Open sqlAdmit, MyConnection, adOpenStatic, adLockPessimistic
rs_Admit.AddNew
rs_Admit.Fields(0) = Text3(0).Text
rs_Admit.Fields(1) = Text3(1).Text
rs_Admit.Fields(2) = txtDept.Text
rs_Admit.Fields(3) = Text3(5).Text
rs_Admit.Fields(4) = Text2(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
rs_Wish.MoveNext
'设置前一条和第一条按钮可用
cmdForward.Enabled = True
cmdFirst.Enabled = True
'如果已经是最后一条记录，则提示用户
If rs_Stu.EOF = True Or rs_Wish.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“后一条”和最后一条按钮不可用
cmdAfterward.Enabled = False
cmdLast.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 7
Text3(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
rs_Grade.MoveNext
For i = 0 To 7
Text2(i).Text = rs_Grade.Fields(i + 2)
Next i
' rs_Wish.MoveNext
For i = 0 To 5
Text1(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.MoveNext
For i = 0 To 3
Text4(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.MoveNext
For i = 0 To 13
Text5(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -