📄 b基本信息.frm
字号:
Width = 615
End
Begin VB.Label Label7
Caption = "出生日期:"
Height = 375
Index = 0
Left = 2640
TabIndex = 22
Top = 960
Width = 1335
End
Begin VB.Label Label8
Caption = "(8位)"
Enabled = 0 'False
ForeColor = &H000000FF&
Height = 255
Left = 2280
TabIndex = 21
Top = 480
Width = 615
End
End
Begin VB.Frame FrameStuList
Caption = "学生列表"
Height = 5415
Left = 120
TabIndex = 18
Top = 240
Width = 2055
Begin VB.ListBox ListStu
Height = 4935
Left = 120
TabIndex = 19
Top = 240
Width = 1815
End
End
End
End
Attribute VB_Name = "B基本信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim strClassNo As String '班号
Dim flag As String '判断是新增加记录还是修改记录
Private Sub FixData() '显示数据
Dim stuNo As String '学号
If ListStu.ListCount > 0 Then
stuNo = Left(Trim(ListStu.Text), 8)
End If
FrameStuInfo.Caption = stuNo & "号学生信息"
'查找数据
rs.MoveFirst
rs.Find ("学号='" & stuNo & "'")
txtItem(0).Text = Trim(rs.Fields("学号"))
txtItem(1).Text = Trim(rs.Fields("姓名"))
If IsDate(Trim(rs.Fields("入学日期"))) Then
DTPicker1(0).Value = Trim(rs.Fields("入学日期")) '时间控件
End If
CboSelect(0).Text = Trim(rs.Fields("性别"))
If IsDate(Trim(rs.Fields("出生日期"))) Then
DTPicker1(1).Value = Trim(rs.Fields("出生日期")) '时间控件
End If
txtItem(2).Text = Trim(rs.Fields("籍贯"))
CboSelect(1).Text = Trim(rs.Fields("民族"))
txtItem(3).Text = Trim(rs.Fields("身份证号"))
CboSelect(2).Text = Trim(rs.Fields("政治面貌"))
txtItem(4).Text = Trim(rs.Fields("电话"))
txtItem(5).Text = Trim(rs.Fields("住址"))
txtItem(6).Text = Trim(rs.Fields("邮箱"))
txtItem(7).Text = Trim(rs.Fields("教育背景"))
txtItem(8).Text = Trim(rs.Fields("备注"))
'控件可用性
For Index = 1 To 8
txtItem(Index).Enabled = False
Next Index
For Index = 0 To 2
CboSelect(Index).Enabled = False
Next Index
For Index = 0 To 1
DTPicker1(0).Enabled = False
Next Index
End Sub
Private Function CheckData() As Boolean
'检查数据的合法性
Dim rst As ADODB.Recordset
Dim msgt As String
msgt = ""
'检查数据非空性
If Trim(txtItem(0).Text) = "" Then
msgt = "学号为空; "
ElseIf Not Len(Trim(txtItem(0).Text)) = 8 Then
msgt = "学号不是8位; "
ElseIf Not Left(Trim(txtItem(0).Text), 6) = strClassNo Then
msgt = "学号错误; "
End If
If Trim(txtItem(1).Text) = "" Then
msgt = msgt & " 姓名为空; "
End If
If Not msgt = "" Then
MsgBox (msgt)
CheckData = False
Exit Function
End If
'检查唯一性
SQL = " select 学号 from 学生基本信息表 where 学号='" & Trim(txtItem(0).Text) & "'"
Set rst = SelectSQL(SQL, msg)
If flag = "Add" And rst.RecordCount > 0 Then
MsgBox ("该学号已经存在,重复添加!")
rst.Close
CheckData = False
Exit Function
End If
CheckData = True '合法
End Function
Private Sub LoadData()
Dim strItem As String
'初始化学生ListBox
SQL = " select * from 学生基本信息表"
SQL = SQL & " where 班号='" & strClassNo & "' order by 学号"
Set rs = Nothing
Set rs = SelectSQL(SQL, msg)
ListStu.Clear
If rs.RecordCount > 0 Then
Do While (Not rs.EOF) And (Not rs.BOF)
strItem = rs.Fields(0) & " " & rs.Fields(1)
ListStu.AddItem (strItem)
rs.MoveNext
Loop
rs.MoveFirst
ListStu.ListIndex = 0
Else
MsgBox ("目前没有学生信息!")
'控件可用性
CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
CmdCancel.Enabled = False: CmdSave.Enabled = False
Exit Sub
End If
'得到学生的基本信息
Call FixData
'控件可用性
CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
CmdCancel.Enabled = False: CmdSave.Enabled = False
End Sub
Private Sub CmdAdd_Click()
'清空文本框,重新设置下拉框、日期控件
For Index = 0 To 8
txtItem(Index).Text = ""
txtItem(Index).Enabled = True
Next Index
For Index = 0 To 2
CboSelect(Index).ListIndex = 0
CboSelect(Index).Enabled = True
Next Index
For Index = 0 To 1
DTPicker1(Index).Refresh
DTPicker1(Index).Enabled = True
Next Index
ListStu.Enabled = False
txtItem(0).Text = strClassNo
txtItem(0).SetFocus
'设置标志flag
flag = "Add"
'添加、修改、删除按钮不可用,取消、保存按钮可用
CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
'修改操作
If rs.RecordCount > 0 Then
'文本框可用,学号不可以修改
For Index = 1 To 8
txtItem(Index).Enabled = True
Next Index
txtItem(0).Enabled = False '学号控件不可用
ListStu.Enabled = False
For Index = 0 To 2
CboSelect(Index).Enabled = True
Next Index
For Index = 0 To 1
DTPicker1(0).Enabled = True
Next Index
'设置标志flag
flag = "Modify"
'添加、修改、删除按钮不可用,取消、保存按钮可用
CmdCancel.Enabled = True: CmdSave.Enabled = True
CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
Else
MsgBox ("没有可以修改的数据!")
End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
On Error GoTo ErrMsg
If txtItem(0).Text = "" Then
MsgBox ("选择需要删除的学生!")
Exit Sub
End If
If rs.RecordCount > 0 Then
msg = MsgBox("删除该条记录吗?", vbYesNo)
If msg = vbYes Then
rs.Delete
Call LoadData '重新装载数据
'清空文本框,重新设置下拉框、日期控件
For Index = 1 To 8
txtItem(Index).Text = ""
txtItem(Index).Enabled = False
Next Index
For Index = 0 To 2
CboSelect(Index).ListIndex = 0
CboSelect(Index).Enabled = False
Next Index
For Index = 0 To 1
DTPicker1(Index).Refresh
DTPicker1(Index).Enabled = False
Next Index
'按钮可用性处理
CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
MsgBox ("成功删除的数据!")
End If
Else
MsgBox ("没有可删除的数据!")
End If
Exit Sub
ErrMsg:
MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
'取消操作
Call FixData '设置数据
ListStu.Enabled = True
'修改、删除、添加按钮可用,保存和取消按钮不可用
CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub setData()
rs.Fields("学号") = Trim(txtItem(0).Text)
rs.Fields("姓名") = Trim(txtItem(1).Text)
rs.Fields("班号") = Trim(strClassNo)
rs.Fields("入学日期") = Trim(DTPicker1(0).Value) '时间控件
rs.Fields("性别") = Trim(CboSelect(0).Text)
rs.Fields("出生日期") = Trim(DTPicker1(1).Value) '时间控件
rs.Fields("籍贯") = Trim(txtItem(2).Text)
rs.Fields("民族") = Trim(CboSelect(1).Text)
rs.Fields("身份证号") = Trim(txtItem(3).Text)
rs.Fields("政治面貌") = Trim(CboSelect(2).Text)
rs.Fields("电话") = Trim(txtItem(4).Text)
rs.Fields("住址") = Trim(txtItem(5).Text)
rs.Fields("邮箱") = Trim(txtItem(6).Text)
rs.Fields("教育背景") = Trim(txtItem(7).Text)
rs.Fields("备注") = Trim(txtItem(8).Text)
End Sub
Private Sub CmdSave_Click()
On Error GoTo ErrMsg
If Not CheckData Then Exit Sub '如果数据不合法就退出
If flag = "Modify" Then '如果是修改数据
msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
If msg = vbYes Then
Call setData '赋值
Else
Exit Sub
End If
ElseIf flag = "Add" Then '如果是添加新数据
rs.AddNew
Call setData
End If
'更新数据
rs.Update
Call LoadData '重新装载数据
'控件可用性
For Index = 0 To 8
txtItem(Index).Enabled = False
Next Index
For Index = 0 To 2
CboSelect(Index).ListIndex = 0
CboSelect(Index).Enabled = False
Next Index
For Index = 0 To 1
DTPicker1(Index).Refresh
DTPicker1(Index).Enabled = False
Next Index
ListStu.Enabled = True
CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
If flag = "Add" Then
'修改注册信息表
SQL = "update 学生注册信息表 set 学期1='" & Me.DTPicker1(0).Value & "' where 学号='"
SQL = SQL & txtItem(0).Text & "'"
Call ExecuteSQL(SQL, msg)
MsgBox ("成功添加数据!")
Else
MsgBox ("成功更新数据!")
End If
Exit Sub
ErrMsg:
MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub CmdExit_Click()
'退出操作
学生档案管理.Enabled = True
rs.Close
B学生查询.Enabled = True
Unload Me
End Sub
Private Sub Form_Load()
'初始化下拉框
CboSelect(0).AddItem "男"
CboSelect(0).AddItem "女"
CboSelect(0).ListIndex = 0
CboSelect(1).AddItem "汉族"
CboSelect(1).AddItem "回族"
CboSelect(1).AddItem "藏族"
CboSelect(1).AddItem "其他"
CboSelect(1).ListIndex = 0
CboSelect(2).AddItem "党员"
CboSelect(2).AddItem "民主人士"
CboSelect(2).AddItem "团员"
CboSelect(2).AddItem "群众"
CboSelect(2).ListIndex = 0
'得到班号
strClassNo = B学生查询.strQuery
FrameStuInfo.Caption = strClassNo & "班学生列表"
Call LoadData '装载数据
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
学生档案管理.Enabled = True
B学生查询.Enabled = True
Unload Me
End Sub
Private Sub ListStu_Click()
Call FixData
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -