VB学生信息管理系统及源代码.docx
《VB学生信息管理系统及源代码.docx》由会员分享，可在线阅读，更多相关《VB学生信息管理系统及源代码.docx（25页珍藏版）》请在冰豆网上搜索。
VB学生信息管理系统及源代码
VB学生信息管理系统及源代码
OptionExplicit
'标识是否能关闭
DimmbCloseAsBoolean
'标识当前要显示的照片的文件
DimmstrFileNameAsString
PrivateSubForm_Load（）
OnErrorResumeNext
IffrmMain.mnUserType=1Then'学生用户
fraSeek.Enabled=False
fraBrowse.Enabled=False
cmdAdd.Enabled=False
cmdDelete.Enabled=False
txtSerial.Enabled=False
dcbClass.Enabled=False
grdScan.Enabled=False
IfNot（DataEnv.rsStudent.EOFAndDataEnv.rsStudent.BOF）Then
DimTempAsString
Temp="name="&"'"&frmMain.msUserName&"'"
DataEnv.rsStudent.MoveFirst
DataEnv.rsStudent.FindTemp
'刷新所绑定的控件
CallRefreshBinding
EndIf
ExitSub
Else
fraSeek.Enabled=True
fraBrowse.Enabled=True
cmdAdd.Enabled=True
cmdDelete.Enabled=True
txtSerial.Enabled=True
dcbClass.Enabled=True
grdScan.Enabled=True
EndIf
DimrsDepAsNewADODB.Recordset,rsClassAsNewADODB.Recordset
SetrsDep=DataEnv.rsDepartment
SetrsClass=DataEnv.rsClass
rsDep.Open
'从Department表中读取数据，填充cboDep组合框到中
cboDep.Clear
cboDep.AddItem"全部"
'将各个系的id号作为ItemData附加到组合框中
cboDep.ItemData（0）=0
WhileNotrsDep.EOF
cboDep.AddItemrsDep（"Name"）
cboDep.ItemData（cboDep.ListCount-1）=rsDep（"id"）
rsDep.MoveNext
Wend
cboDep.ListIndex=0
''从class表中读取数据，填充到cboClass组合框中
cboClass.Clear
cboClass.AddItem"全部"
WhileNotrsClass.EOF
cboClass.AddItemrsClass（"Name"）
rsClass.MoveNext
Wend
cboClass.ListIndex=0
cmdList.Value=True
fraManage.Enabled=True
mbClose=True
'调用grdScan_Change事件显示记录明细
CallgrdScan_Change
EndSub
'当DataEnv.rsStudent的当前记录发生变化时，刷新所绑定的控件（用户改变了当前记录）
SubRefreshBinding（）
OnErrorResumeNext
WithDataEnv.rsStudent
IfDataEnv.rssqlSeek.BOFAndDataEnv.rssqlSeek.EOFThen
'如果不存在任何记录，则清空所有的绑定的内容
txtSerial=""
txtName=""
dtpBirth.Value=""
txtTelephone=""
txtAddress=""
txtResume=""
imgPhoto.Picture=LoadPicture（Null）
Else'否则和相应的字段进行绑定
txtSerial=.Fields（"serial"）
txtName=.Fields（"name"）
dtpBirth.Value=.Fields（"birthday"）
txtTelephone=.Fields（"tel"）
txtAddress=.Fields（"address"）
txtResume=.Fields（"resume"）
cboSex.Text=.Fields（"sex"）
dcbClass.Text=.Fields（"class"）
imgPhoto.Picture=LoadPicture（ReadImage（.Fields（"photo"）））
EndIf
EndWith
EndSub
''在DataEnv.rsStudent中查询serial为sSerial的学籍信息
SubSeekStudent（sSerialAsString）
IfNot（DataEnv.rsStudent.EOFAndDataEnv.rsStudent.BOF）Then
DimTempAsString
Temp="serial="&"'"&sSerial&"'"
DataEnv.rsStudent.MoveFirst
DataEnv.rsStudent.FindTemp
'刷新所绑定的控件
CallRefreshBinding
EndIf
EndSub
''当改变记录集时，需要刷新用户导航的网格控件
SubRefreshGrid（）
grdScan.DataMember=""
grdScan.Refresh
DataEnv.rssqlSeek.Requery
grdScan.DataMember="sqlSeek"
grdScan.Refresh
'刷新各个绑定控件
CallgrdScan_Change
EndSub
''用以在浏览时，根据当前记录所出的位置不同，来改变各个浏览按钮的状态
SubChangeBrowseState（）
WithDataEnv.rssqlSeek
If.State=adStateClosedThen.Open
'如果没有任何记录，使某些按钮无效；否则则使这些按钮有效
If.BOFAnd.EOFThen
cmdAdd.Enabled=True
cmdEdit.Enabled=False
cmdDelete.Enabled=False
cmdUpdate.Enabled=False
cmdReport.Enabled=False
fraBrowse.Enabled=False
Else
cmdAdd.Enabled=True
cmdEdit.Enabled=True
cmdDelete.Enabled=True
cmdUpdate.Enabled=False
cmdReport.Enabled=True
fraBrowse.Enabled=True
EndIf
''假如处于记录的头部
If.BOFThen
IfNot.EOFThenDataEnv.rsStudent.MoveFirst
cmdPrevious.Enabled=False
cmdFirst.Enabled=False
Else
cmdPrevious.Enabled=True
cmdFirst.Enabled=True
EndIf
''假如处于记录的尾部
If.EOFThen
IfNot.BOFThenDataEnv.rsStudent.MoveLast
cmdNext.Enabled=False
cmdLast.Enabled=False
Else
cmdNext.Enabled=True
cmdLast.Enabled=True
EndIf
EndWith
mstrFileName=""
EndSub
PrivateSubcboDep_Click（）
DimrsClassAsNewADODB.Recordset
DimstrSQL
'根据所选的系的不同，采用不同的SQL语句
IfcboDep.ItemData（cboDep.ListIndex）=0Then
strSQL="select*from班级信息表"
Else
strSQL="select*from班级信息表wheredept_id="&cboDep.ItemData（cboDep.ListIndex）
EndIf
rsClass.OpenstrSQL,DataEnv.Con
'将所查到的rsClass中的内容来填充cboClass
cboClass.Clear
cboClass.AddItem"全部"
WhileNotrsClass.EOF
cboClass.AddItemrsClass（"Name"）
rsClass.MoveNext
Wend
cboClass.ListIndex=0
rsClass.Close
SetrsClass=Nothing
EndSub
PrivateSubcmdAdd_Click（）
'添加记录
fraSeek.Enabled=False
fraBrowse.Enabled=False
grdScan.Enabled=False
DataEnv.rsStudent.AddNew
dtpBirth.Value="1980-01-01"
fraInfo.Enabled=True
fraBrowse.Enabled=False
cmdAdd.Enabled=False
cmdEdit.Enabled=False
cmdDelete.Enabled=False
cmdUpdate.Enabled=True
cmdReport.Caption="取消"
cmdReport.Enabled=True
mbClose=False'不能关闭窗口
EndSub
PrivateSubcmdDelete_Click（）
'如果出错，则显示错误代码
OnErrorGoToerrHandler
IfMsgBox（"要删除记录?
",vbYesNo+vbQuestion+vbDefaultButton2,"确认"）=vbYesThen
'通过在DataEnv.Con中执行SQL命令，来删除记录
DataEnv.Con.Execute"deletefrom学生信息表whereserial='"&txtSerial&"'"
DataEnv.rsStudent.MoveNext
IfDataEnv.rsStudent.EOFThenDataEnv.rsStudent.MoveLast
'刷新用户导航的网格控件
CallRefreshGrid
EndIf
ExitSub
errHandler:
MsgBoxErr.Description,vbCritical,"错误"
EndSub
PrivateSubcmdEdit_Click（）
'编辑记录之前，需要设置其他控件的Enabled属性
fraSeek.Enabled=False
fraBrowse.Enabled=False
grdScan.Enabled=False
fraInfo.Enabled=True
cmdAdd.Enabled=False
cmdEdit.Enabled=False
cmdDelete.Enabled=False
cmdUpdate.Enabled=True
cmdReport.Caption="取消"''更改cmdReport标题
cmdReport.Enabled=True
mbClose=False'出于编辑状态，则用户不能关闭窗口
EndSub
PrivateSubcmdFirst_Click（）
'移动到记录的头部，并改变各个浏览按钮的状态
DataEnv.rssqlSeek.MoveFirst
DataEnv.rssqlSeek.MovePrevious
CallChangeBrowseState
EndSub
PrivateSubcmdLast_Click（）
'移动到记录的尾部，并改变各个浏览按钮的状态
DataEnv.rssqlSeek.MoveLast
DataEnv.rssqlSeek.MoveNext
CallChangeBrowseState
EndSub
PrivateSubcmdList_Click（）
'针对所选的班级，列出班级中所有的学籍信息
DimstrSQL
IfcboClass.Text="全部"Then
strSQL="from学生信息表orderbyserial"
Else
strSQL="from学生信息表whereclass='"&cboClass&"'orderbyserial"
EndIf
DataEnv.rsStudent.Close
DataEnv.rsStudent.Open"select*"&strSQL
DataEnv.rssqlSeek.Close
DataEnv.rssqlSeek.Open"selectserial,name"&strSQL
'刷新用户导航的网格控件，并且根据记录集中记录的数目，来改变各个浏览按钮的状态。
CallRefreshGrid
CallChangeBrowseState
CallgrdScan_Change
EndSub
PrivateSubcmdNext_Click（）'移动到记录的下一条
DataEnv.rssqlSeek.MoveNext
CallChangeBrowseState
EndSub
PrivateSubcmdPrevious_Click（）'移动到记录的上一条
DataEnv.rssqlSeek.MovePrevious
CallChangeBrowseState
EndSub
PrivateSubcmdReport_Click（）
OnErrorResumeNext
IfcmdReport.Caption="取消"Then
'取消所使用的更新更新
DataEnv.rsStudent.CancelUpdate
'重新显示原来数据集中的内容
IfDataEnv.rsStudent.BOFThen
DataEnv.rsStudent.MoveFirst
Else
DataEnv.rsStudent.MovePrevious
DataEnv.rsStudent.MoveNext
EndIf
CallRefreshBinding
CallChangeBrowseState
fraSeek.Enabled=True
fraBrowse.Enabled=True
fraInfo.Enabled=False
grdScan.Enabled=True
cmdReport.Caption="报表（R）"
mbClose=True
Else
'生成报表
DimstrSQLAsString
DataEnv.rsrptStudent.Close
strSQL="select*from学生信息表whereserial='"&txtSerial.Text&"'"
DataEnv.rsrptStudent.OpenstrSQL
rptStudent.Show
EndIf
EndSub
PrivateSubcmdSelectPhoto_Click（）
OnErrorGoToerrHandler:
dlgSelect.DialogTitle="选择该学生的照片"
dlgSelect.Filter="所有图形文件|*.bmp;*.dib;*.gif;*.jpg;*.ico|位图文件（*.bmp;*.dib）"&_
"|*.bmp;*.dib|GIF文件（*.gif）|*.gif|JPEG文件（*.jpg）|*.jpg|图标文件（*.ico）|*.ico"
dlgSelect.ShowOpen
IfdlgSelect.FileName=""ThenExitSub
imgPhoto.Picture=LoadPicture（dlgSelect.FileName）
mstrFileName=dlgSelect.FileName
ExitSub
errHandler:
MsgBoxErr.Description,vbCritical,"错误"
EndSub
PrivateSubcmdUpdate_Click（）
'更新所添加或者修改的记录
OnErrorGoToerrHandler:
DimstrAsString
str=txtSerial.Text
WithDataEnv.rsStudent
.Fields（"Serial"）=txtSerial.Text
.Fields（"name"）=txtName.Text
.Fields（"sex"）=cboSex.Text
.Fields（"class"）=dcbClass.Text
.Fields（"birthday"）=dtpBirth.Value
.Fields（"tel"）=txtTelephone.Text
.Fields（"address"）=txtAddress.Text
.Fields（"resume"）=txtResume.Text
IfmstrFileName<>""ThenCallWriteImage（.Fields（"photo"）,mstrFileName）
.Update
EndWith
cmdReport.Caption="报表（&R）"
cmdUpdate.Enabled=False
fraInfo.Enabled=False
mbClose=True
IfDataEnv.rssqlSeek.State=adStateClosedThenDataEnv.rssqlSeek.Open
'刷新右端用以导航的网格控件
CallRefreshGrid
'根据记录集中记录的个数，改变各个按钮的状态
CallChangeBrowseState
'定位到刚刚添加或者修改过的记录
DataEnv.rssqlSeek.MoveFirst
DataEnv.rssqlSeek.Find"serial='"&str&"'"
fraSeek.Enabled=True
fraBrowse.Enabled=True
grdScan.Enabled=True
ExitSub
errHandler:
MsgBoxErr.Description,vbCritical,"错误"
EndSub
PrivateSubdcbClass_Click（AreaAsInteger）
IftxtSerial=""Then
txtSerial=dcbClass.Text
EndIf
EndSub
PrivateSubForm_QueryUnload（CancelAsInteger,UnloadModeAsInteger）
IfNotmbCloseThen
MsgBox"数据正被修改，窗口不能关闭",vbCritical,"错误"
Cancel=True
EndIf
EndSub
PrivateSubfraInfo_DragDrop（SourceAsControl,XAsSingle,YAsSingle）
EndSub
PrivateSubgrdScan_Change（）
IfgrdScan.ApproxCount>0Then
CallSeekStudent（grdScan.Columns（0）.CellText（grdScan.Bookmark））
EndIf
EndSub
PrivateSubgrdScan_RowColChange（LastRowAsVariant,ByValLastColAsInteger）
'当前行改变，则动态改变所要显示的记录
IfLastRow<>grdScan.BookmarkThen
IfgrdScan.ApproxCount>0Then
CallSeekStudent（grdScan.Columns（0）.CellText（grdScan.Bookmark））
EndIf
EndIf
EndSub
PrivateSubWriteImage（ByRefFldAsADODB.Field,DiskFileAsString）
DimbyteData（）AsByte'定义数据块数组
DimNumBlocksAsLong'定义数据块个数
DimFileLengthAsLong'标识文件长度
DimLeftOverAsLong'定义剩余字节长度
DimSourceFileAsLong'定义自由文件号
DimiAsLong'定义循环变量
ConstBLOCKSIZE=4096'每次读写块的大小
SourceFile=FreeFile'提供一个尚未使用的文
升级会员 