基于VB和Access的学生成绩管理系统

含全套代码+数据库文件 mdb private sub txtoldpassword lostfocus if oldpassword <> txtoldpassword text then msgbox "密码不正确 " "密码错误" txtoldpassword setfocus end if end sub private sub form unload cancel as integer set mclsmidtier nothing lusersrs close userrs close set lusersrs nothing set userrs nothing end sub private sub startpos cmdadduser enabled true cmddeleteuser enabled true lstusers tabindex 0 txtusername tabindex 1 txtpassword tabindex 2 txtreenter tabindex 3 txtoldpassword tabindex 4 cmdadduser tabindex 6 cmddeleteuser tabindex 7 cmdchangepassword tabindex 8 lblpassword top 600 txtpassword top 600 lblreenter top 960 txtreenter top 960 lbloldpassword top 1320 txtoldpassword 1320 lblnewpassword top 1680 lstusers enabled true txtusername enabled true lblpassword visible true txtpassword visible true lblnewpassword visible false lblreenter visible false txtreenter visible false lbloldpassword visible false txtoldpassword visible false end sub private sub changepos cmdadduser enabled false cmddeleteuser enabled false lblpassword visible false txtpassword visible true txtpassword top 960 lblnewpassword top 960 lblreenter top 1320 txtreenter top 1320 lbloldpassword top 600 txtoldpassword top 600 txtoldpassword tabindex 1 txtpassword tabindex 2 txtreenter tabindex 3 lstusers enabled false txtusername enabled false lblnewpassword visible true lblreenter visible true txtreenter visible true lbloldpassword visible true txtoldpassword visible true end sub private const margin size 60 " in twips " variables for data binding private datprimaryrs as adodb recordset " variables for enabling column sort private m isortcol as integer private m isorttype as integer private mclsmidtier as clsmidtier dim scmd as string dim strquerystr as string dim mlclasscode as string dim mstrstudentno as string dim mloldclasscode as string private sub form load dim i as integer mlclasscode "" mloldclasscode "" mstrstudentno "" set mclsmidtier new clsmidtier scmd "select from studentinfo" set datprimaryrs mclsmidtier getlist scmd dim otext as textbox "bind the text boxes to the data provider for i 0 to me txtfields count 1 set me txtfields i datasource datprimaryrs me txtfields i locked true next "设置性别组合框可选项目 set cbostudentsex datasource datprimaryrs cbostudentsex additem "男" cbostudentsex additem "女" "设置班级组合框可选项目 dim classrsgrade as recordset "年级数据 dim classrsclassno as recordset "班级序号 dim classrsclasslength as recordset "学制 dim classrsclassspecialty as recordset "专业 set classrsgrade mclsmidtier getlist "select distinct schoolgrade from class" set classrsclassno mclsmidtier getlist "select distinct classno from class" set classrsclasslength mclsmidtier getlist "select distinct lengthofschool from class" set classrsclassspecialty mclsmidtier getlist "select distinct specialtyname from class" if classrsgrade recordcount <> 0 then classrsgrade movefirst for i 1 to classrsgrade recordcount cbostuclassgrade additem classrsgrade 0 classrsgrade movenext next i for i 1 to classrsclassno recordcount cbostuclassno additem classrsclassno 0 classrsclassno movenext next i for i 1 to classrsclasslength recordcount cbostuclasslength additem classrsclasslength 0 classrsclasslength movenext next i for i 1 to classrsclassspecialty recordcount cbostuclassspecialty additem classrsclassspecialty 0 classrsclassspecialty movenext next i end if "关闭数据集 classrsgrade close classrsclassno close classrsclasslength close classrsclassspecialty close set classrs nothing set classrsclassno nothing set classrsclasslength nothing set classrsclassspecialty nothing "设置表格布局和风格 with mshflexgrid1 redraw false " set grid"s column widths colwidth 0 200 colwidth 1 1200 colwidth 2 1000 colwidth 3 500 colwidth 4 2600 colwidth 5 1000 colwidth 6 2000 colwidth 7 1000 colwidth 8 1600 colwidth 9 1000 colwidth 10 1200 textmatrix 0 1 "学号" textmatrix 0 2 "姓名" textmatrix 0 3 "性别" textmatrix 0 4 "班级" textmatrix 0 5 "出生年月" textmatrix 0 6 "家庭住址" textmatrix 0 7 "邮政编码" textmatrix 0 8 "联系电话" textmatrix 0 9 "入学时间" textmatrix 0 10 "备注" colalignment 1 " set grid"s style allowbigselection true fillstyle flexfillrepeat " make header bold row 0 col 0 rowsel fixedrows 1 colsel cols 1 cellfontbold true cellalignment 1 allowbigselection false redraw true end with "填充表格数据 call showmsh【fg】riddata datprimaryrs me mshflexgrid1 end sub private sub cbostuclassgrade click if len trim me cbostuclassgrade text <> 0 then me txtfields 2 text me cbostuclassgrade text strquerystr " schoolgrade "" & me cbostuclassgrade text & """ mstrstudentno mid me cbostuclassgrade text 1 4 "学号前四位取年级号 me cbostuclasslength enabled true end if end sub private sub cbostuclasslength click if len trim me cbostuclasslength text <> 0 then me txtfields 2 text me cbostuclassgrade text & me cbostuclasslength text strquerystr strquerystr & " and " & " lengthofschool "" & me cbostuclasslength text & """ me cbostuclassspecialty enabled true end if end sub private sub cbostuclassspecialty click if len trim me cbostuclassspecialty text <> 0 then me txtfields 2 text me cbostuclassgrade text & me cbostuclasslength text & me cbostuclassspecialty text strquerystr strquerystr & " and " & " specialtyname "" & me cbostuclassspecialty text & """ me cbostuclassno enabled true end if end sub private sub cbostuclassno click me txtfields 2 text me cbostuclassgrade text & me cbostuclasslength text & me cbostuclassspecialty text & me cbostuclassno text strquerystr strquerystr & " and " & " classno "" & me cbostuclassno text & """ mloldclasscode mlclasscode "保存原班级编码 dim classrscode as recordset set classrscode mclsmidtier getlist "select classcode from class" strquerystr if classrscode recordcount > 0 then mlclasscode classrscode 0 for i 1 to me txtfields count 1 me txtfields i locked false next me txtfields 2 locked true if mstrstudentno "" then mstrstudentno cstr val getfldvalue mlclasscode + 1 datprimaryrs 0 mstrstudentno else if mlclasscode <> mloldclasscode then mstrstudentno cstr val getfldvalue mlclasscode + 1 datprimaryrs 0 mstrstudentno end if end if if mloldclasscode "" then mloldclasscode mlclasscode "第一次 保存原班级编码 end if else msgbox "无该班 请重新设置班级信息 " vbinformation "警告" for i 1 to me txtfields count 1 me txtfields i locked true next datprimaryrs 0 "" me cbostuclasslength enabled false me cbostuclassspecialty enabled false me cbostuclassno enabled false end if me cbostuclassgrade text "" me cbostuclasslength text "" me cbostuclassspecialty text "" me cbostuclassno text "" me txtfields 1 setfocus end sub private sub cbostudentsex keypress keyascii as integer if keyascii 13 then sendkeys "{tab}" end if end sub private sub form unload cancel as integer set datprimaryrs nothing set mclsmidtier nothing end sub private sub mshflexgrid1 click call cmdcancel click dim mncurrow as long mncurrow me mshflexgrid1 row if datprimaryrs recordcount <> 0 then datprimaryrs movefirst datprimaryrs move mncurrow 1 end if end sub private sub mshflexgrid1 dblclick " " code in grid"s dblclick event enables column sorting " dim i as integer " sort only when a fixed row is clicked if mshflexgrid1 mouserow > mshflexgrid1 fixedrows then exit sub i m isortcol " save old column m isortcol mshflexgrid1 col " set new column " increment sort type if i <> m isortcol then " if clicking on a new column start with ascending sort m isorttype 1 else " if clicking on the same column toggle between ascending and descending sort m isorttype m isorttype + 1 if m isorttype 3 then m isorttype 1 end if docolumnsort end sub sub docolumnsort " " does exchange type sort on column m isortcol " with mshflexgrid1 redraw false row 1 rowsel rows 1 col m isortcol sort m isorttype redraw true end with end sub private sub form resize dim sngframetop as single dim sngscalewidth as single dim sngscaleheight as single on error goto form resize error with me sngscalewidth scalewidth sngscaleheight scaleheight " move close button to the lower right corner with frame1 sngframetop sngscaleheight height + margin size " move sngscalewidth width + margin size sngframetop end with mshflexgrid1 move margin size margin size sngscalewidth 2 margin size sngframetop 2 margin size frame1 move margin size mshflexgrid1 height + 2 margin size sngscalewidth 2 margin size frame1 height frame2 width frame1 width 200 frame3 width frame1 width 200 cmdclose move sngscalewidth 8 margin size cmdclose width lblnote move sngscalewidth 8 margin size lblnote width end with exit sub form resize error: " avoid error on negative values resume next end sub private sub cmdclose click unload me end sub public function getfldvalue mstrparval as string as string dim strwhere as string strwhere "left 学号 7 "" & mstrparval & """ dim rsmaxschno as recordset set rsmaxschno mclsmidtier getlist "select 学号 from studentinfo" strwhere if rsmaxschno recordcount > 0 then rsmaxschno sort "学号" " ascending" rsmaxschno movelast getfldvalue rsmaxschno "学号" value else getfldvalue mlclasscode & "000" end if rsmaxschno close set rsmaxschno nothing end function private sub cmdadd click on error goto adderr dim oldvalue as string "原班级信息 oldvalue me txtfields 2 text "显示原班级信息 strquerystr "" "查询班级的id号条件清空 me cbostuclassgrade enabled true "允许年级组合框输入 me txtfields 0 locked true "锁住学号框 with datprimaryrs if not bof and eof then mvbookmark bookmark end if addnew mbaddnewflag true end with if len trim mlclasscode <> 0 then if mlclasscode mloldclasscode then mstrstudentno cstr val mstrstudentno + 1 datprimaryrs 0 mstrstudentno end if end if datprimaryrs 3 oldvalue me txtfields 1 setfocus cmdadd enabled false cmddelete enabled false cmdupdate enabled true cmdcancel enabled true exit sub adderr: msgbox err description end sub private sub cmdcancel click if not datprimaryrs eof or datprimaryrs bof then datprimaryrs cancelupdate end if mlclasscode "" mloldclasscode "" mstrstudentno "" me cmdadd enabled true me cmddelete enabled true me cmdupdate enabled true me cmdcancel enabled true me cbostuclassgrade enabled false me cbostuclassno enabled false me cbostuclasslength enabled false me cbostuclassspecialty enabled false end sub private sub cmdupdate click on error goto updateerr for each otext in me txtfields if otext text "" then msgbox "你必须输入数据 " vbinformation "提示" exit sub end if next datprimaryrs updatebatch adaffectall if mbaddnewflag then if datprimaryrs recordcount <> 0 then adoprimaryrs movelast "移到新记录 end if call showmsh【fg】riddata datprimaryrs me mshflexgrid1 me cmdadd enabled true me cmddelete enabled true me cmdupdate enabled true me cmdcancel enabled true me cbostuclassgrade enabled false me cbostuclassno enabled false me cbostuclasslength enabled false me cbostuclassspecialty enabled false mbeditflag false mbaddnewflag false mbdatachanged false exit sub updateerr: msgbox err description end sub private sub cmddelete click on error goto deleteerr if me mshflexgrid1 textmatrix me mshflexgrid1 row 1 "" or datprimaryrs recordcount 0 then msgbox "没有要删除的记录 " vbinformation "提示" exit sub else if msgbox "你确定要删除数据吗 " vbquestion + vbokcancel + vbdefaultbutton2 "提示" vbok then with datprimaryrs delete movenext if eof and datprimaryrs recordcount <> 0 then movelast if bof then movefirst end with call showmsh【fg】riddata datprimaryrs me mshflexgrid1 end if exit sub end if deleteerr: msgbox err description end sub private sub txtfields keypress index as integer keyascii as integer if keyascii 13 then keyascii 0 sendkeys "{tab}" end if end sub">含全套代码+数据库文件 mdb private sub txtoldpassword lostfocus if oldpassword <> txtoldpassword text t