VB学生信息管理系统及源代码.docx

1、VB学生信息管理系统及源代码VB学生信息管理系统及源代码Option Explicit标识是否能关闭Dim mbClose As Boolean标识当前要显示的照片的文件Dim mstrFileName As StringPrivate Sub Form_Load() On Error Resume Next If frmMain.mnUserType = 1 Then 学生用户 fraSeek.Enabled = False fraBrowse.Enabled = False cmdAdd.Enabled = False cmdDelete.Enabled = False txtSerial

2、.Enabled = False dcbClass.Enabled = False grdScan.Enabled = False If Not (DataEnv.rsStudent.EOF And DataEnv.rsStudent.BOF) Then Dim Temp As String Temp = name = & & frmMain.msUserName & DataEnv.rsStudent.MoveFirst DataEnv.rsStudent.Find Temp 刷新所绑定的控件 Call RefreshBinding End If Exit Sub Else fraSeek.

3、Enabled = True fraBrowse.Enabled = True cmdAdd.Enabled = True cmdDelete.Enabled = True txtSerial.Enabled = True dcbClass.Enabled = True grdScan.Enabled = True End If Dim rsDep As New ADODB.Recordset, rsClass As New ADODB.Recordset Set rsDep = DataEnv.rsDepartment Set rsClass = DataEnv.rsClass rsDep.

4、Open 从Department表中读取数据，填充cboDep组合框到中 cboDep.Clear cboDep.AddItem 全部 将各个系的id号作为ItemData附加到组合框中 cboDep.ItemData(0) = 0 While Not rsDep.EOF cboDep.AddItem rsDep(Name) cboDep.ItemData(cboDep.ListCount - 1) = rsDep(id) rsDep.MoveNext Wend cboDep.ListIndex = 0 从class表中读取数据，填充到cboClass组合框中 cboClass.Clear c

5、boClass.AddItem 全部 While Not rsClass.EOF cboClass.AddItem rsClass(Name) rsClass.MoveNext Wend cboClass.ListIndex = 0 cmdList.Value = True fraManage.Enabled = True mbClose = True 调用grdScan_Change事件显示记录明细 Call grdScan_ChangeEnd Sub当DataEnv.rsStudent的当前记录发生变化时，刷新所绑定的控件(用户改变了当前记录)Sub RefreshBinding() On

6、 Error Resume Next With DataEnv.rsStudent If DataEnv.rssqlSeek.BOF And DataEnv.rssqlSeek.EOF Then 如果不存在任何记录，则清空所有的绑定的内容 txtSerial = txtName = dtpBirth.Value = txtTelephone = txtAddress = txtResume = imgPhoto.Picture = LoadPicture(Null) Else 否则和相应的字段进行绑定 txtSerial = .Fields(serial) txtName = .Fields(

7、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) End If End WithEnd Sub在DataEnv.rsStudent中查询serial为sSerial的学

8、籍信息Sub SeekStudent(sSerial As String) If Not (DataEnv.rsStudent.EOF And DataEnv.rsStudent.BOF) Then Dim Temp As String Temp = serial = & & sSerial & DataEnv.rsStudent.MoveFirst DataEnv.rsStudent.Find Temp 刷新所绑定的控件 Call RefreshBinding End IfEnd Sub当改变记录集时，需要刷新用户导航的网格控件Sub RefreshGrid() grdScan.DataMe

9、mber = grdScan.Refresh DataEnv.rssqlSeek.Requery grdScan.DataMember = sqlSeek grdScan.Refresh 刷新各个绑定控件 Call grdScan_ChangeEnd Sub用以在浏览时，根据当前记录所出的位置不同，来改变各个浏览按钮的状态Sub ChangeBrowseState() With DataEnv.rssqlSeek If .State = adStateClosed Then .Open 如果没有任何记录，使某些按钮无效；否则则使这些按钮有效 If .BOF And .EOF Then cmdA

10、dd.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 End

11、 If 假如处于记录的头部 If .BOF Then If Not .EOF Then DataEnv.rsStudent.MoveFirst cmdPrevious.Enabled = False cmdFirst.Enabled = False Else cmdPrevious.Enabled = True cmdFirst.Enabled = True End If 假如处于记录的尾部 If .EOF Then If Not .BOF Then DataEnv.rsStudent.MoveLast cmdNext.Enabled = False cmdLast.Enabled = Fal

12、se Else cmdNext.Enabled = True cmdLast.Enabled = True End If End With mstrFileName = End SubPrivate Sub cboDep_Click() Dim rsClass As New ADODB.Recordset Dim strSQL 根据所选的系的不同，采用不同的SQL语句 If cboDep.ItemData(cboDep.ListIndex) = 0 Then strSQL = select * from 班级信息表 Else strSQL = select * from 班级信息表 where

13、 dept_id= & cboDep.ItemData(cboDep.ListIndex) End If rsClass.Open strSQL, DataEnv.Con 将所查到的rsClass中的内容来填充cboClass cboClass.Clear cboClass.AddItem 全部 While Not rsClass.EOF cboClass.AddItem rsClass(Name) rsClass.MoveNext Wend cboClass.ListIndex = 0 rsClass.Close Set rsClass = NothingEnd SubPrivate Sub

14、 cmdAdd_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 cmdRe

15、port.Caption = 取消 cmdReport.Enabled = True mbClose = False 不能关闭窗口End SubPrivate Sub cmdDelete_Click() 如果出错，则显示错误代码 On Error GoTo errHandler If MsgBox(要删除记录?, vbYesNo + vbQuestion + vbDefaultButton2, 确认) = vbYes Then 通过在DataEnv.Con中执行SQL命令，来删除记录 DataEnv.Con.Execute delete from 学生信息表 where serial = &

16、txtSerial & DataEnv.rsStudent.MoveNext If DataEnv.rsStudent.EOF Then DataEnv.rsStudent.MoveLast 刷新用户导航的网格控件 Call RefreshGrid End If Exit SuberrHandler: MsgBox Err.Description, vbCritical, 错误End SubPrivate Sub cmdEdit_Click() 编辑记录之前，需要设置其他控件的Enabled属性 fraSeek.Enabled = False fraBrowse.Enabled = False

17、 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 出于编辑状态，则用户不能关闭窗口End SubPrivate Sub cmdFirst_Click() 移动到记录的头部，并改变各个浏览按钮的状态 Da

18、taEnv.rssqlSeek.MoveFirst DataEnv.rssqlSeek.MovePrevious Call ChangeBrowseStateEnd SubPrivate Sub cmdLast_Click() 移动到记录的尾部，并改变各个浏览按钮的状态 DataEnv.rssqlSeek.MoveLast DataEnv.rssqlSeek.MoveNext Call ChangeBrowseStateEnd SubPrivate Sub cmdList_Click() 针对所选的班级，列出班级中所有的学籍信息 Dim strSQL If cboClass.Text = 全部

19、 Then strSQL = from 学生信息表 order by serial Else strSQL = from 学生信息表 where class= & cboClass & order by serial End If DataEnv.rsStudent.Close DataEnv.rsStudent.Open select * & strSQL DataEnv.rssqlSeek.Close DataEnv.rssqlSeek.Open select serial, name & strSQL 刷新用户导航的网格控件，并且根据记录集中记录的数目，来改变各个浏览按钮的状态。 Cal

20、l RefreshGrid Call ChangeBrowseState Call grdScan_ChangeEnd SubPrivate Sub cmdNext_Click() 移动到记录的下一条 DataEnv.rssqlSeek.MoveNext Call ChangeBrowseStateEnd SubPrivate Sub cmdPrevious_Click() 移动到记录的上一条 DataEnv.rssqlSeek.MovePrevious Call ChangeBrowseStateEnd SubPrivate Sub cmdReport_Click() On Error Re

21、sume Next If cmdReport.Caption = 取消 Then 取消所使用的更新更新 DataEnv.rsStudent.CancelUpdate 重新显示原来数据集中的内容 If DataEnv.rsStudent.BOF Then DataEnv.rsStudent.MoveFirst Else DataEnv.rsStudent.MovePrevious DataEnv.rsStudent.MoveNext End If Call RefreshBinding Call ChangeBrowseState fraSeek.Enabled = True fraBrowse

22、.Enabled = True fraInfo.Enabled = False grdScan.Enabled = True cmdReport.Caption = 报表(R) mbClose = True Else 生成报表 Dim strSQL As String DataEnv.rsrptStudent.Close strSQL = select * from 学生信息表 where serial = & txtSerial.Text & DataEnv.rsrptStudent.Open strSQL rptStudent.Show End IfEnd SubPrivate Sub c

23、mdSelectPhoto_Click() On Error GoTo errHandler: dlgSelect.DialogTitle = 选择该学生的照片 dlgSelect.Filter = 所有图形文件|*.bmp;*.dib;*.gif;*.jpg;*.ico|位图文件(*.bmp;*.dib) & _ |*.bmp;*.dib|GIF文件(*.gif)|*.gif|JPEG文件(*.jpg)|*.jpg|图标文件(*.ico)|*.ico dlgSelect.ShowOpen If dlgSelect.FileName = Then Exit Sub imgPhoto.Pictu

24、re = LoadPicture(dlgSelect.FileName) mstrFileName = dlgSelect.FileName Exit SuberrHandler: MsgBox Err.Description, vbCritical, 错误End SubPrivate Sub cmdUpdate_Click() 更新所添加或者修改的记录 On Error GoTo errHandler: Dim str As String str = txtSerial.Text With DataEnv.rsStudent .Fields(Serial) = txtSerial.Text

25、.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 If mstrFileName Then Call WriteImage(.Fields(photo), mstrFileName) .Update En

26、d With cmdReport.Caption = 报表(&R) cmdUpdate.Enabled = False fraInfo.Enabled = False mbClose = True If DataEnv.rssqlSeek.State = adStateClosed Then DataEnv.rssqlSeek.Open 刷新右端用以导航的网格控件 Call RefreshGrid 根据记录集中记录的个数，改变各个按钮的状态 Call ChangeBrowseState 定位到刚刚添加或者修改过的记录 DataEnv.rssqlSeek.MoveFirst DataEnv.rs

27、sqlSeek.Find serial= & str & fraSeek.Enabled = True fraBrowse.Enabled = True grdScan.Enabled = True Exit SuberrHandler: MsgBox Err.Description, vbCritical, 错误End SubPrivate Sub dcbClass_Click(Area As Integer) If txtSerial = Then txtSerial = dcbClass.Text End IfEnd SubPrivate Sub Form_QueryUnload(Can

28、cel As Integer, UnloadMode As Integer) If Not mbClose Then MsgBox 数据正被修改，窗口不能关闭, vbCritical, 错误 Cancel = True End IfEnd SubPrivate Sub fraInfo_DragDrop(Source As Control, X As Single, Y As Single)End SubPrivate Sub grdScan_Change() If grdScan.ApproxCount 0 Then Call SeekStudent(grdScan.Columns(0).Ce

29、llText(grdScan.Bookmark) End IfEnd SubPrivate Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer) 当前行改变，则动态改变所要显示的记录 If LastRow grdScan.Bookmark Then If grdScan.ApproxCount 0 Then Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark) End If End IfEnd SubPrivate Sub WriteImage(ByRef Fld As ADODB.Field, DiskFile As String) Dim byteData() As Byte 定义数据块数组 Dim NumBlocks As Long 定义数据块个数 Dim FileLength As Long 标识文件长度 Dim LeftOver As Long 定义剩余字节长度 Dim SourceFile As Long 定义自由文件号 Dim i As Long 定义循环变量 Const BLOCKSIZE = 4096 每次读写块的大小 SourceFile = FreeFile 提供一个尚未使用的文