主程序.prg

用VB做的学生成绩管理系统。欢迎大家来下载

            DO xinjian1
            RETU
        ENDIF
    ELSE
        SELE 0
        USE (file1)  ALIAS cjk
        SELE cjk
        ****************推测年级值开始****************************************
        RECALL ALL
        DELE FOR  备注="删除"
        PACK
        BLAN ALL  FIELDS 去尾
        REPL ALL 删除 WITH "*" FOR 备注="流失"
        REPL ALL 删除 WITH "*" FOR 备注="转走"
        REPL ALL 删除 WITH "*" FOR 备注="留级"
        REPL ALL 删除 WITH "#" FOR 备注="借读"
        REPL ALL 删除 WITH "#" FOR 备注="寄读"
        REPL ALL 删除 WITH "#" FOR 备注="晚来"
        REPL ALL 删除 WITH "#" FOR 备注="转入"
        REPL ALL 删除 WITH "#" FOR 备注="坐级"
        DELE FOR 删除="*" &&
        ********找出最少班的人数
        REPL ALL 班级 WITH VAL(SUBS(考号,2,2))
        GO TOP
        LOCA FOR LEFT(考号,1) $ "123" .AND. 删除<>"*"
        IF FOUND()
            nj= VAL(LEFT(考号,1))
        ELSE
            IF "一年级" $  wjm1
                nj=1
            ENDIF
            IF "二年级" $  wjm1
                nj=2
            ENDIF
            IF "三年级" $  wjm1
                nj=3
            ENDIF
        ENDIF
        GO TOP
        LOCA FOR kl="2"
        IF FOUND()
            sffwlk=2
        ELSE
            sffwlk=1
        ENDIF
        njmc=SUBS(dxhz,nj*2-1,2)+"年级"
        ***************推测年级值------结束***************************************

        ***************推测年份、阶段、考试全称值------开始***********************
        *pathDBF=LEFT(file1,RAT("\",file1))  &&路径未尾已带了"\"
        ksqc=STRT(wjm1,"成绩","")
        IF LEFT(ksqc,1) $ ("0123456789")
            dqnf=IIF(BETW(VAL(ksqc),1952,2051),VAL(ksqc),IIF(BETW(VAL(ksqc),52,99),VAL(ksqc)+1900,VAL(ksqc)+2000))
        ELSE
            dqnf=YEAR(dqrq)
        ENDIF
        jdmc=SUBS(wjm1,AT("年级",wjm1)+4,AT("考试",wjm1)-(AT("年级",wjm1)+4))
        IF jdmc $ jdmc_all
            jdmcbh=INT((AT(jdmc,jdmc_all)+5)/6)
            jdmc=ALLT(SUBS(jdmc_all,jdmcbh*6-5,6))
            ksqc=STR(dqnf,4)+"年"+njmc+jdmc+"考试"
        ELSE
            ****根据文件名推测不成,则根据当前日期来猜测
            DO tcnfrqjdmc
        ENDIF
        **********************************************
        SET SAFE OFF
        INDE ON 班级 TO cjkidx
        SET SAFE OFF
        DO tcbjm &&推测班级名
        DO tckmm &&推测科目名
        DO tcmcm &&推测名次名
        ***************推测文、理班级数，文、理班级名称----结束***********************

        ***************对推测值进行***********************
        DO tcbjrs
        DO FORM  班级信息
        DO FORM  科目信息
        DO FORM  校验分数
        sele cjk
        REPL ALL kl WITH IIF(sffwlk=1,'1',IIF(SUBS(sy_bj,班级*2-1,2) $ wk_bj,'2','1'))
        BLANK ALL FIELDS 去尾
        IF  sftjzbs
            RECALL FOR  删除="#"
        ELSE
            DELE FOR 删除="#"
        ENDIF
        DO tcklxx
        IF MESSAGEBOX("是否继续打开相对应的教师积分表",36,"确 认")=6
            IF mima<>'z'+STRT(ALLT(STRT(STR(COS(SIN(VAL(SYS(2020))*2)),12,10),'.','')),'-','')
                =MESSAGEBOX("    试用版,只能由计算机填入模拟数据!不能导入、打开、录入数据请记下机器号";
                    +CHR(13)+"与白水高中:朱光锐 联系获得序列号,TEL:[phone]!,感谢支持正版!",16,"未授权!")
                DO xinjian2
            ELSE
                DO dakai2
            ENDIF
        ENDIF
    ENDI
ENDPROC
******************************************************************************************
PROC dakai2() &&子程序：打开积分表,读取教师信息，初始化有关变量

    IF mima<>'z'+STRT(ALLT(STRT(STR(COS(SIN(VAL(SYS(2020))*2)),12,10),'.','')),'-','')
        =MESSAGEBOX("    试用版,只能由计算机填入模拟数据!不能导入、打开、录入数据请记下机器号";
            +CHR(13)+"与白水高中:朱光锐 联系获得序列号,TEL:[phone]!,感谢支持正版!",16,"未授权!")
        RETU
    ENDIF
    IF ALLT(DBF(1))==""
        =MESSAGEBOX("打开积分表之前，请先打开成绩库",0,"提示")
        RETU
    ENDIF
    SET DEFA TO &pathdbf
    file2=GETFI("DBF",'教师积分表','打开',0,"打开教师积分表")
    wjm2=STRT(RIGHT(file2,LEN(file2)-RAT("\",file2)),".DBF","")
    SET DEFA TO &path0
    IF .NOT. FILE(file2)
        IF MESSAGEBOX("指定的文件&FILE2.不存在,未打开积分表!,是否新建一个积分表",36,"提示")=6
            DO xinjian2
            RETU
        ELSE
            SELE cjk
            RETU
        ENDIF
        IF .NOT. ALLT(DBF(2))==""
            SELE 2
            USE
            SELE cjk
            RETU
        ENDIF
    ELSE
        USE (file2) IN 2 ALIA jjk
    ENDIF
    SELE jjk
    BLANK ALL FIEL jsh
    REPL ALL kl WITH "1" FOR SUBS(sy_bj,bj*2-1,2) $ "LK_BJ" .AND. bj>0
    REPL ALL kl WITH "2" FOR SUBS(sy_bj,bj*2-1,2) $ "WK_BJ" .AND. bj>0
    REPL ALL 班级名 WITH  LEFT(njmc,2)+SUBS(sy_bj,bj*2-1,2)+"班" FOR bj>0 .AND. bj<=bjs
    ****************推测文理科目名，及科目数及要统计的字段，对教师进行编号*********************************
    SET SAFE OFF
    INDE ON klh TO jjkidx
    SET SAFE OFF
    SELE jjk
    REPL ALL klh WITH (AT(科目名,sy_km)+3)/4
    REPL ALL bj WITH  (AT(SUBS(班级名,3,2),sy_bj)+1)/2 FOR AT(SUBS(班级名,3,2),sy_bj)>0
    BLAN ALL FIELDS bj  FOR AT(SUBS(班级名,3,2),sy_bj)=0
    jss=0
    jsm="_^_^_^"
    BLANK ALL FIELDS jsh
    SET SAFE OFF
    INDE ON STR(klh,3)+教师名 TO jjkidx
    SET SAFE OFF
    GO TOP
    SCAN  FOR klh<kms .AND. .NOT. DELE() .AND. bj>0
        IF .NOT. 教师名==jsm
            jsm=教师名
            jss=jss+1
        ENDIF
        REPL  jsh WITH jss
    ENDS
    GO TOP
    jsm="_^_^_^"
    SET SAFE OFF
    INDE ON 教师名+IIF(jsh>0,STR(jsh,3),"999") TO jjkidx
    SET SAFE OFF
    SCAN FOR  bj>0
        IF  教师名==jsm
            REPL   jsh WITH xxx
        ELSE
            xxx=jsh
            jsm=教师名
        ENDIF
    ENDS
    DO tcmcm &&推测名次名
    GO TOP
    SCAN FOR .NOT. DELE()
        IF (kl $ "2" .AND. 科目名 $ kmmc_all) .AND.  .NOT. (科目名 $ wk_km)
            =MESSAGEBOX("积分表中的文科科目与成绩表中文科科目对不上,建议重建",0,"提示")
            RETU
        ENDIF
        IF (kl $ "1" .AND. 科目名 $ kmmc_all) .AND.  .NOT. (科目名 $ lk_km)
            =MESSAGEBOX("积分表中的科目与成绩表中科目对不上,建议重建",0,"提示")
            RETU
        ENDIF
    ENDS
    GO TOP
    SCAN FOR .NOT. DELE()
        IF kl $ "2" .AND. SUBS(班级名,3,2) $ bjmc_all .AND. .NOT.  (SUBS(班级名,3,2) $ wk_bj)
            =MESSAGEBOX("积分表中的文科班级与成绩表中文科班级名对不上,建议重建",0,"提示")
            RETU

        ENDIF
        IF kl $ "1" .AND. SUBS(班级名,3,2) $ bjmc_all .AND. .NOT.  (SUBS(班级名,3,2) $ lk_bj)
            =MESSAGEBOX("积分表中的班级与成绩表中班级名对不上,建议重建",0,"提示")
            RETU
        ENDIF
    ENDS
    GO TOP
    FOR i=1 TO kms
        IF  SUBS(sy_km,i*4-3,4) $ lk_km
            COUN FOR klh=i .AND. 科目名=SUBS(sy_km,i*4-3,4) .AND. kl='1' .AND. bj=0 TO x
            IF x<>1
                =MESSAGEBOX("积分表中的汇总项不对,将自动重建,但须填备课组长名",0,"提示")
                DO zjhzsj
                RETU
            ENDIF
        ENDIF
        GO TOP
        IF sffwlk=2  .AND.SUBSTR(sy_km,i*4-3,4) $ wk_km
            COUN FOR klh=i .AND. 科目名=SUBS(sy_km,i*4-3,4) .AND. kl='2' .AND. bj=0 TO x
            IF x<>1
                =MESSAGEBOX("积分表中的汇总项不对,将自动重建",0,"提示")
                DO zjhzsj
                RETU
            ENDIF
        ENDIF
    ENDF
ENDPROC

PROC cjdaochu() &&另存为....
    SELE cjk
    x= MESSAGEBOX("    选择【是】将按考号后三位的顺序号导出成绩表,选择【否】将按";
        +CHR(13)+"以班为单位,按考号从小到大来导出成绩表,选择【取消】放弃",547,"选择")
    SET SAFE OFF
    IF x=6
        INDE ON SUBS(考号,4,3) TO cjkidx
    ELSE
        INDE ON 考号 TO cjkidx
    ENDI
    SET SAFE ON
    file4=DBF()
    wjm4=STRT(RIGHT(file4,LEN(file4)-RAT("\",file4)),".DBF","")&&不带路径,不带扩展名".DBF"的文件名
    filea=PUTF("导为XLS/DBF",pathbak+wjm4,"DBF;XLS")
    BROW NOMODI NOAPP NODELE
    IF filea==''
        =MESSAGEBOX("文件名不存!",0,"提示")
        RETU
    ENDI
    IF RIGHT(ALLT(filea),3)=="XLS"
        SET SAFE OFF
        COPY TO (filea)  TYPE  XL5
        SET SAFE ON
    ELSE
        IF RIGHT(ALLT(filea),3)=="DBF"
            SET SAFE OFF
            COPY TO (filea)
            SET SAFE ON
        ENDI
    ENDI
ENDPROC
PROC jfdaochu
    SELE jjk
    file5=DBF()
    wjm5=STRT(RIGHT(file5,LEN(file5)-RAT("\",file5)),".DBF","")&&不带路径,不带扩展名".DBF"的文件名
    fileb=PUTF("导为XLS/DBF",pathbak+wjm5,"DBF;XLS")
    SET SAFE OFF
    IF RIGHT(ALLT(fileb),3)=="XLS"
        COPY TO (fileb)  TYPE  XL5
    ELSE
        IF RIGHT(ALLT(fileb),3)=="DBF"
            COPY TO (fileb)
        ENDI
    ENDI
    SET SAFE ON
ENDPROC
***************************************
PROC tuichu() &&退出系统
    SET SYSMENU TO DEFAULT
    CLEA EVENTS
    CLEA  WINDOW 动画1
    RELEASE MENU MAIN
    CLEA EVENTS
    SET TALK ON
    SET SAFE ON
    SET STAT ON
    SET SCOR ON
    =IMES(0)
    =INSM(.T.)
    *quit
ENDPROC
PROC xinjian1() &&新建一个空的成绩表
    CLOSE DATA
    DO FORM 班级信息
    wjm1=ksqc+'成绩'
    file1=pathdbf+wjm1
    file1=PUTFILE("新建成绩：",file1,"DBF")
    IF ALLT(file1)==""
        =MESSAGEBOX("成绩表，未命名，没能建立！",0,"提示")
        RETU
    ENDI
    wjm1=STRT(RIGHT(file1,LEN(file1)-RAT("\",file1)),".DBF","")
    CLOS DATA
    SET SAFE OFF
    CREA TABLE (file1)  (考号 c(6), 姓名 c(8),班级 N(2))
    SET SAFE ON
    DO FORM 科目信息
    USE  (DBF())  ALIA cjk
    FOR i=1 TO kms-1
        zdm=SUBS(sy_km,i*4-3,4)
        ALTE TABLE (DBF()) ADD (zdm) N(5,1)
    ENDF
    ALTE TABLE (DBF()) ADD 总分 N(6,1)
    FOR i=1 TO kms
        zdm=SUBS(tj_bmc,i*4-3,4)
        ALTE TABLE  (DBF()) ADD (zdm) N(2)
    ENDF
    FOR i=1 TO kms
        zdm=SUBS(tj_zmc,i*4-3,4)
        ALTE TABLE (DBF())  ADD (zdm) N(4)
    ENDF
    IF nj=1
        x= MIN(5,jdmcbh)
    ENDIF
    IF nj=2
        x= 4+MAX(MIN(5,jdmcbh),2)
    ENDIF
    IF nj=3
        IF jdmcbh>5
            x= 8+MAX(MIN(6,jdmcbh-1),5)
        ELSE
            x= 8+MAX(MIN(4,jdmcbh),2)
        ENDIF
    ENDIF
    FOR i=1 TO lncjh[MAX(1,MIN(X,14))]
        zdm="H"+ALLT(STR(i))
        zdm1="HMLX"+ALLT(STR(i))
        zdm2="HMKD"+ALLT(STR(i))
        xxzdm=&zdm+" "+&zdm1+" ("+ALLT(STR(&zdm2))+")"
        ALTE TABLE (DBF())  ADD &xxzdm
    ENDF
    ALTE TABLE (DBF())  ADD kl c(1)
    ALTE TABLE (DBF())  ADD 去尾 lb_p(1)
    ALTE TABLE (DBF())  ADD 新班 N(2)
    ALTE TABLE (DBF())  ADD 新号 c(6)
    ALTE TABLE (DBF())  ADD 考室 N(2)
    ALTE TABLE (DBF())  ADD 删除 c(1)
    ALTE TABLE (DBF())  ADD 备注 c(10)
    DO FORM  校验分数
    SELE cjk
    x= MESSAGEBOX("成绩表已建立,让电脑根据班级数及班人数自动为"+CHR(13)+"该表追加考号,姓名,班级等数据!请选择【是】"+;
        CHR(13)+"从文件中导入数据,请选择【否】,放弃请选择【取消】",547,"选择")
    IF x=6
        DO addcjb
    ENDI
    IF x=7
        IF mima<>'z'+STRT(ALLT(STRT(STR(COS(SIN(VAL(SYS(2020))*2)),12,10),'.','')),'-','')
            =MESSAGEBOX("    试用版,只能由计算机填入模拟数据!不能导入数据,更不能录入数据!请记下机器号";