main.prg

学生生长发育软件

***************************
* MAIN.prg
***************************
set escape off
set talk off
set dohistory off
set safety off
set status off
set scoreboard off
set date ansi
set color to w/0,,
load hj
clear
@ 24 , 0 say ""
load vga
load hbk
set color to W/1,,

restore from setup.zzb
OK = inkey(0)
public ODHXS1 , OMHXS1 , ODH , OMH , OSXK , ODXK , ODSXK , ODHXS , OMHXS , OC;
DH , OVER , OCZXT , O44 , AQWJ , KLJ1 , KLJ
public OKTS , OYS , OBZXS , OGD , OWJMC , OGSWJ , OQJS , OBJS , SMSWMC , OLOO;
P , OZZXM , OCZY , OCJYH
OCJYH = .t.
OCZY = "      "
OQJS = "7"
OBJS = "1"
OGD = 1
OKTS = 1
OBZXS = .t.
OVER = "2.1B"
dimension OKT(10,2) , OTSB(6) , OCD(71) , OHCD(10,3)
on error   do smerro with erro()
ODHXS1 = "            Esc 退出  →↑↓←光标键移动光带  回车键选择指定项目 "
OTSB(1) = "3/6,w+/3,"
OTSB(2) = "0/2,2+/4,"
OTSB(3) = "0/3,3+/4,"
OTSB(4) = "7+/4,0/7,"
OTSB(5) = "7+/5,0/3,"
OTSB(6) = "0/7,7+/4,"
OCDH = 1
OYS = OTSB(1)
ODHXS = ODHXS1
O = 256
on error 
select 9
use main.hlp alias I
OBZZS = reccount()
select 10
use main.cdk alias J
set color to w/1,,n
clear
@ 24 , 0 say ""
call hbk with "00002479Z"
set color to w/1,,
@ 2 , 1 say replicate("━",39)
@ 17 , 1 say replicate("─",39)
@ 22 , 1 say replicate("━",39)
@ 23 , 1 say ODHXS
@ 24 , 0 say ""
set escape off
set color to 0/3,,
select 10
go top
scatter to OCD
go OCD(31)
OCDH = OCD(31)
OZCD1 = 坐标X
OI = 0
OHCDX = 2
do while OI<10
  OI = OI+1
  OHCD(OI,1) = trim(OCD(OI))
  OHCD(OI,2) = OCD(OI+30)
  OHCD(OI,3) = OHCDX
  go OHCD(OI,2)
  replace 坐标X with iif(OHCD(OI,3)+宽度<72,OHCD(OI,3),72-宽度)
  OHCDX = OHCDX+len(OHCD(OI,1))+1
  if OHCDX<80.and.len(OHCD(OI,1))>0
    OHCDS = OI
  else
    OHCDX = 100
  endif
enddo
if OHCDS=1
  go OCDH
  replace 坐标X with OZCD1
  OHCD(1,3) = int((80-len(OHCD(1,1)))/2)
  set color to 0/7,,
  @ 1 , 15 say space(50)
  @ 1 , OHCD(1,3) say OHCD(1,1)
  @ 24 , 0 say ""
  call hbk with "01150164j"
else
  set color to 0/7,,
  OI = 1
  do while OI<=OHCDS
    @ 1 , OHCD(OI,3) say OHCD(OI,1)
    @ 24 , 0 say ""
    call hbk with "01"+str(OHCD(OI,3),2)+"01"+str(OHCD(OI,3)+len(OHCD(OI,1))-;
1,2)+"j"
    OI = OI+1
  enddo
endif
set color to w/1,,n
call hbk with "00002479Z"
@ 23 , 1 say ODHXS
SQWJ = AQDY+space(8-len(AQDY))
do smggp with "请输入数据库名：         (.dbf)" , 11 , 24
@ 11 , 40 say "" get SQWJ
read
aqwj='.\dat\'+trim('&sqwj')+'.dbf'
if .not.file('&aqwj')
  do smggp with '文件'+trim('&sqwj')+'不存在！创建吗（Ｙ／Ｎ）？',11,24
  O = inkey(0)
  if O=89.or.O=121.or.O=13
    select 1
    use sgtzb alias A
    copy stru to &aqwj
    AQDY = SQWJ
  else
    set color to w/0,,
    clear
    @ 24 , 0 say ""
    set clear off
    quit
    return
  endif
else
  AQDY = SQWJ
endif
save to setup.zzb all like ??dy
set color to w/1,,n
@ 4 , 10 clear to 16 , 68
select 10
OCDH = OHCD(1,2)
OHCDW = 1
set color to 0/w,,
@ 1 , OHCD(OHCDW,3) say OHCD(OHCDW,1)
go OHCD(OHCDW,2)
scatter to OCD
O = 13
OGD = 1
OYS = OTSB(OCD(41))
go OCDH
scatter to OCD
OYS = OTSB(OCD(41))
OJK = str(OCD(43),2)+str(OCD(42),2)+str(OCD(43)+1+OCD(45),2)+str(OCD(42)+OCD(;
44)+3,2)+"Z"
set color to 1/0,,
@ OCD(43)+1 , OCD(42)+2 clear to OCD(43)+2+OCD(45) , OCD(42)+OCD(44)+5
set color to &oys
@ OCD(43) , OCD(42) clear to OCD(43)+1+OCD(45) , OCD(42)+OCD(44)+3
call hbk with OJK
O44 = ltrim(str(OCD(44),2))
call hbk with str(OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)+"08a"
OI = 1
do while OI<=OCD(45)
  set color to &oys
  @ OI+OCD(43) , OCD(42)+2 say trim(left(OCD(OI),OCD(44)))
  @ 24 , 0 say ""
  HXC = str(OI+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
  call hbk with HXC+"08a"
  call hbk with HXC+"15b"
  OI = OI+1
enddo
HXC = str(OI+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
call hbk with HXC+"15b"
set color to 7+/3,,
@ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
call hbk with str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OGD+OCD(43),2)+str(OCD(;
42)+OCD(44)+2,2)+"c"
do while .t.
  set color to &oys
  O = 0
  set color to w/1,,
  @ 16 , 70 say time()
  @ 24 , 0 say ""
  do while O=0
    O = inkey(0.4)
    if O=0.and.OBZXS
      if OCD(OGD+20)>0
        OBZXS = .f.
        select 9
        go OCD(OGD+20)
        @ 18 , 1 clear to 21 , 78
        @ 18 , 2 say trim(HA)
        @ 19 , 2 say trim(HB)
        @ 20 , 2 say trim(HC)
        @ 21 , 2 say trim(HD)
        select 10
      else
        if OBZXS
          OBZXS = .f.
          @ 18 , 1 clear to 21 , 78
          @ 24 , 0 say ""
        endif
      endif
      O = inkey(0.4)
    endif
    @ 16 , 70 say time()
    @ 24 , 0 say ""
  enddo
  OBZXS = .t.
  set color to &oys
  do case
  case O=5
    @ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
    @ 24 , 0 say ""
    HXC = str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
    call hbk with HXC+"08a"
    call hbk with HXC+"15b"
    OGD = iif(OGD>1,OGD-1,OCD(45))
    set color to 7+/3,,
    @ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
    call hbk with str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OGD+OCD(43),2)+str(;
OCD(42)+OCD(44)+2,2)+"c"
    loop
  case O=24
    @ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
    HXC = str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
    call hbk with HXC+"08a"
    call hbk with HXC+"15b"
    OGD = iif(OGD<OCD(45),OGD+1,1)
    set color to 7+/3,,
    @ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
    call hbk with str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OGD+OCD(43),2)+str(;
OCD(42)+OCD(44)+2,2)+"c"
    loop
  case O=4.and.OKTS=1.and.OHCDS>1
    set color to 0/7,,
    @ 1 , OHCD(OHCDW,3) say OHCD(OHCDW,1)
    @ 24 , 0 say ""
    call hbk with "01"+str(OHCD(OHCDW,3),2)+"01"+str(OHCD(OHCDW,3)+len(OHCD(O;
HCDW,1))-1,2)+"j"
    set color to w/1,,
    @ OCD(43) , OCD(42) clear to OCD(43)+2+OCD(45) , OCD(42)+OCD(44)+5
    OHCDW = iif(OHCDW<OHCDS,OHCDW+1,1)
    set color to 0/7,,
    @ 1 , OHCD(OHCDW,3) say OHCD(OHCDW,1)
    @ 24 , 0 say ""
    call hbk with "01"+str(OHCD(OHCDW,3),2)+"01"+str(OHCD(OHCDW,3)+len(OHCD(O;
HCDW,1))-1,2)+"i"
    OCDH = OHCD(OHCDW,2)
    OGD = 1
  case O=19.and.OKTS=1.and.OHCDS>1
    OGD = 1
    set color to 0/7,,
    @ 1 , OHCD(OHCDW,3) say OHCD(OHCDW,1)
    @ 24 , 0 say ""
    call hbk with "01"+str(OHCD(OHCDW,3),2)+"01"+str(OHCD(OHCDW,3)+len(OHCD(O;
HCDW,1))-1,2)+"j"
    set color to w/1,,
    @ OCD(43) , OCD(42) clear to OCD(43)+2+OCD(45) , OCD(42)+OCD(44)+5
    OHCDW = iif(OHCDW>1,OHCDW-1,OHCDS)
    set color to 0/7,,
    @ 1 , OHCD(OHCDW,3) say OHCD(OHCDW,1)
    @ 24 , 0 say ""
    call hbk with "01"+str(OHCD(OHCDW,3),2)+"01"+str(OHCD(OHCDW,3)+len(OHCD(O;
HCDW,1))-1,2)+"i"
    OCDH = OHCD(OHCDW,2)
  case O=27
    set color to 7/1,1/7,
    if OKTS>1
      @ OCD(43) , OCD(42) clear to OCD(43)+OCD(45)+2 , OCD(42)+OCD(44)+5
      OKTS = OKTS-1
      OGD = OKT(OKTS,2)
      OCDH = OKT(OKTS,1)
      if OKTS>1
        do smqpxs
      endif
    else
      OKT(1,2) = OGD
      set color to w/0,,
      do smggp with " 是否退出系统(Y/N)" , 9 , 27
      O = inkey(0)
      if O=89.or.O=121.or.O=13
        set color to w/0,,
        clear
        @ 24 , 0 say ""
        set clear off
        quit
        return
      endif
      set color to w/1,,
      @ 8 , 25 clear to 11 , 59
    endif
    go OCDH
    scatter to OCD
    OYS = OTSB(OCD(41))
    set color to &oys
    O44 = ltrim(str(OCD(44),2))
    OGD = OKT(OKTS,2)
    OJK = str(OCD(43),2)+str(OCD(42),2)+str(OCD(43)+1+OCD(45),2)+str(OCD(42)+;
OCD(44)+3,2)+"Z"
    call hbk with OJK
  case O=13
    if OCD(OGD+30)>11.and.OKTS<9
      OKT(OKTS,1) = OCDH
      OKT(OKTS,2) = OGD
      OKTS = OKTS+1
      OCDH = OCD(OGD+30)
      OGD = 1
    else
      OMK = trim(OCD(OGD+10))
      if len(OMK)>0
        save to mainbl.$$$ all like o*
        on error   do smerro with erro()
        do &omk
        restore from mainbl.$$$ additive
        select 9
        use main.hlp alias I
        OBZZS = reccount()
        select 10
        use main.cdk alias J
        do smzcd
        do smqpxs
      endif
    endif
  otherwise
    if O=255
      @ 18 , 1 clear to 21 , 78
      @ 19 , 20 say "超级菜单自动生成系统 版本号 2.0A"
      @ 20 , 27 say "程序设计:李炳一"
      O = inkey(0)
    else
      OBZXS = .f.
    endif
    loop
  endcase
  go OCDH
  scatter to OCD
  OYS = OTSB(OCD(41))
  OJK = str(OCD(43),2)+str(OCD(42),2)+str(OCD(43)+1+OCD(45),2)+str(OCD(42)+OC;
D(44)+3,2)+"Z"
  set color to 1/0,,
  @ OCD(43)+1 , OCD(42)+2 clear to OCD(43)+2+OCD(45) , OCD(42)+OCD(44)+5
  set color to &oys
  @ OCD(43) , OCD(42) clear to OCD(43)+1+OCD(45) , OCD(42)+OCD(44)+3
  call hbk with OJK
  O44 = ltrim(str(OCD(44),2))
  call hbk with str(OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)+"08a;
"
  OI = 1
  do while OI<=OCD(45)
    @ OI+OCD(43) , OCD(42)+2 say trim(left(OCD(OI),OCD(44)))
    @ 24 , 0 say ""
    HXC = str(OI+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
    call hbk with HXC+"08a"
    call hbk with HXC+"15b"
    OI = OI+1
  enddo
  HXC = str(OI+OCD(43),2)+str(OCD(42)+1,2)+str(OCD(42)+OCD(44)+2,2)
  call hbk with HXC+"15b"
  set color to 7+/3,,
  @ OGD+OCD(43) , OCD(42)+1 say " "+left(OCD(OGD),OCD(44))+" "
  call hbk with str(OGD+OCD(43),2)+str(OCD(42)+1,2)+str(OGD+OCD(43),2)+str(OC;
D(42)+OCD(44)+2,2)+"c"
enddo
return