Liren Large Software Subsidy 5/05.iso/a/a056/5.ddi/RS/YQMIS001.PRG

Text File | 1993-12-21 | 21.5 KB | 1,299 lines

*******************************************************
* ╬─╝■├√│╞: YQMIS001
* │╠╨≥╔Φ╝╞: ╤┼╞µ
* ▒α│╠╚╒╞┌: 93.12.21   21:26:25
*******************************************************
priv aqwj
set safe off
set date ansi
close data
set color to w/1,,
clear
do smggp with '╟δ  ╔╘  ║≥ !',10,34
set color to w/1,,
sele A
aqwj='RS'
sele 8
use RS alia h
index on ╨╒├√ to RS
sele B
use RSJL alia B
index on ╨╒├√ to RSJL
sele 8
copy stru to olswj.ls
sele 1
use olswj.ls alia a
appe blan
sele A
set rela to ╨╒├√ into B addi
set proc to YQMIS001
priv ozdm,ogzq,oh,ol,ok,oj,ofz,owyzd
owyzd='╨╒├√'
ofz=.f.
ok=-1
oj=.f.
do while .t.
set color to 7/1,1/7,
clear
call hj with '00007924'
@ 2,1 say repl('⌐Ñ',39)
@ 22,1 say repl('⌐Ñ',39)
set dele off
@ 1,2 say '╝╟┬╝║┼:           ╝╟┬╝╫▄╩²:         '
@ 23,16 say '^End:═╦│÷ ^Home:╧╘╩╛╣ª─▄▓╦╡Ñ ^PgUp:╜°╚δ╡τ╫╙▒¿▒φ '
@ 5,2 say '                           ═¿╙├╚╦╩┬╡╡░╕┬╝╚δ│╠╨≥'
@ 6,2 say '                       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
@ 7,2 say '     ⌐│⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╖'
@ 8,2 say '     ⌐º╨╒├√:       ⌐º╨╘▒≡:   ⌐º╡Ñ╬╗:       ⌐º│÷╔·╚╒╞┌:         ⌐º'
@ 9,2 say '     ⌐╟⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐▀⌐Ñ⌐Ñ⌐╫⌐Ñ⌐▀⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐▀⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╧'
@ 10,2 say '     ⌐º╣ñ╫≈╩▒╝Σ:         ⌐º╬─╗»│╠╢╚:     ⌐º╝╝╩⌡╓░│╞:           ⌐º'
@ 11,2 say '     ⌐╟⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐∩⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐▀⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╧'
@ 12,2 say '     ⌐º╗∙▒╛╣ñ╫╩:         ⌐º╓░╬±╜≥╠∙:         ⌐º─Ω┴Σ:           ⌐º'
@ 13,2 say '     ⌐╟⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐▀⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐▀⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╧'
@ 14,2 say '     ⌐º▒╧╥╡╤º╨ú:                     ⌐º─Ω┴Σ╢╬:                 ⌐º'
@ 15,2 say '     ⌐╗⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐▀⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐┐'
set color to w+/1,,
sele 1
@ 1,29 say recc() pict '@B 99999999'
sele 9
use odm.lby inde odm alia i
sele 10
use YQMIS001.olr alia j
priv ozdlx,ofw,ozdxh
wjm=left(sys(16),len(sys(16))-4)
sele 1
goto bott
do xs
sele 10
goto top
set color to w+/1,0/w,
do while .t.
   ozdxh=recn()
   ozdlx=╫╓╢╬└α╨═
   ozdm=trim(╫╓╢╬├√)
   ogzq=╟°
   ojg=╕─
   oh=╨╨+2
   ol=┴╨+2
   ocd=┤╩╡Σ
   if ozdlx='N'
     if ╔╧╧▐=0.AND.╧┬╧▐=0
        ofw=' '
     else
       ofw='rang '+ltrim(str(╧┬╧▐,19,2))+','+ltrim(str(╔╧╧▐,19,2))
     endif
   else
     ofw=' '
   endif
   sele 1
   if ogzq='A'.and..not.ojg
     do while .t.
      @ oh,ol get &ozdm &ofw
      if ocd
         clea get
         ozdmc=ozdm
         do odm
      else
         read
      endif
     if ozdxh=1
       owy=.f.
       do wyxjc with &ozdm
       if owy
         exit
       endif
     else
       exit
     endif
    @ 1,60 say '╡▒╟░╩²╛▌╓╪╕┤!!'
    ?? repl(chr(7),12)
    @ 1,60 say '              '
    enddo
      ok=read()
      if ok>255
         goto recn()
         do js
      endif
      ok=mod(ok,256)
      @ oh,ol say &ozdm
   endif
   sele 10
   do case
   case ok=4.or.ok=0.or.ok=2
        if .not.bof()
           oj=.f.
           skip -1
        endif
        if bof()
           goto top
           sele 1
           if .not.eof()
              skip -1
           endif
           if bof()
              goto top
           endif
           do xs
        endif
   case ok=1.or.ok=5.or.ok=15
        if .not.eof()
           skip
        endif
        if eof()
           sele 1
           if .not.eof()
           skip
           endif
           if eof()
              do zj
           endif
           do xs
           goto top
        endif
   case ok=6
        oj=.f.
        sele 1
        if .not.bof()
           skip -1
        endif
        if bof()
           goto top
        endif
        do xs
   case ok=7
        sele 1
        if .not.eof()
           skip
        endif
        if eof()
           do zj
        endif
        do xs
   case ok=33
        do cd
   case ok=14.or.ok=12
        do smggp with '┤µ┼╠═╦│÷  ╖┼╞·═╦│÷',10,31
        set color to ,0/w,
        @ 10,31 prom '┤µ┼╠═╦│÷'
        @ 10,41 prom '╖┼╞·═╦│÷'
        menu to ok
        sele 8
        use
        sele 1
        if ok=1
           pack
           use &aqwj alia a
           appe from olswj.ls
        endif
        use
        dele file olswj.ls
        close proc
        close data
        return
   case ok=34
        sele 1
     do brow
        exit
   othe
        if .not.eof()
           skip
        endif
        if eof()
           goto top
           sele 1
           if .not.eof()
              skip
           endif
           if eof()
              goto top
           endif
           do xs
        endif
   endcase
   sele 10
enddo
enddo
return

****************
* ╧╘╩╛╦∙╙╨╫╓╢╬ *
****************
proc xs
priv ozdm,ogzq,oh,ol
sele 1
set color to w+/1,,
do xsjlh
if dele()
   set color to r+/1,,
else
   set color to w+/1,,
endif
sele 10
goto top
do while .not.eof()
   ozdm=trim(╫╓╢╬├√)
   ogzq=╟°
   oh=╨╨+2
   ol=┴╨+2
   sele 1
   @ oh,ol say &ogzq.->&ozdm
   sele 10
   skip
enddo
goto top
ok=5
return

****************
* ╫╖╝╙╝╟┬╝     *
****************
proc zj
priv ok,olsbl(128)
dime OLSBL(128)
sele 1
if ofz
   goto bott
   scat to olsbl
endif
if oj
   appe blan
   if ofz
      gath from olsbl
   endif
   @ 1,29 say recc() pict '@B 99999999'
else
   set color to w+/1,,
   @ 21,30 say '╩╟╖±╫╖╝╙╨┬╡─╝╟┬╝?(Y/N)'
   ok=chr(abs(inkey(0)))
   @ 21,30 say '                      '
   if ok$'Yy'
      oj=.t.
      appe blan
      if ofz
         gath from olsbl
      endif
      @ 1,29 say recc() pict '@B 99999999'
   else
      goto bott
   endif
endif
return

****************
*   ┬╝╚δ▓╦╡Ñ   *
****************
proc cd
priv o,tx(7)
dime tx(7)
sele 1
@ oh,ol get &ozdm
clear get
tx(1)='╝╟┬╝▓┘╫≈'
tx(2)='╫╓╢╬╧▐╓╞'
tx(3)='╔╛│²╝╟┬╝'
tx(4)='╜√╕─╫╓╢╬'
tx(5)='╝ñ╗ε╫╓╢╬'
tx(6)='┤·┬δ╖╜╩╜'
tx(7)='╣½╩╜╝╞╦π'
o=0
do menu with 7
set color to w+/1,,
do case
case o=1
     sele 1
     tx(1)='╬─╝■┐¬═╖'
     tx(2)='╬─╝■╬▓▓┐'
     tx(3)='╓╕╢¿╝╟┬╝'
     tx(4)='╝╟┬╝╕┤╓╞'
     tx(5)='╚í╧√╕┤╓╞'
     tx(6)='▓σ╚δ╝╟┬╝'
     do menu with 6
     set color to w+/1,,
     @ 1,53 say space(26)
     @ 21,0 say space(80)
     call hj with '00007924'
     do case
     case o=1
          goto top
     case o=2
          goto bott
     case o=3
          o=recn()
          @ 1,53 say '╝╟┬╝║┼:' get o rang 1,recc() pict '@B'
          read
          @ 1,53 say space(26)
          goto o
     case o=4
          ofz=.t.
     case o=5
          ofz=.f.
     case o=6
     inse befor blan
     do xs
     sele 1
     set color to w+/1,,
     @ 1,29 say recc() pict '@B 99999999'
     endcase
     do xs
     sele 1
case o=2.and.ozdlx='N'
     set color to w/1,,
     @ 21,1 say space(78)
     sele 10
     @ 21,2 say '╩²╛▌╧┬╧▐:' get ╧┬╧▐
     @ 21,32 say '╩²╛▌╔╧╧▐:' get ╔╧╧▐
     read
     @ 21,1 say space(78)
case o=3
     sele 1
     if dele()
        reca
      else
        dele
      endif
      do xs
case o=4
     sele 10
     repl ╕─ with .t.
     oa=1
     sele 1
     set color to w+/1,,
     @ oh,ol say &ozdm
     ok=5
case o=5
     sele 10
     ol0=recn()
     repl ╕─ with .f. all
     goto ol0
case o=6
     sele 10
     if ╫╓╢╬└α╨═='C'
        repl ┤╩╡Σ with iif(┤╩╡Σ,.f.,.t.)
        oa=1
        sele 1
        set color to w+/1,,
        @ oh,ol say &ozdm
     endif
case o=7
     do gs
endcase
set color to w+/1,1/7,
return

****************
*   ┤·┬δ╠µ╗╗   *
****************
proc odm
set exact on
odm='        '
set color to w+/r,,
@ 21,1 say '╩Σ╚δ┤·┬δ:'get odm pict '!!!!!!!!'
read
if odm='        '
   @ 21,1 say space(78)
   set color to w+/1,,
   retu
endif
sele 9
seek ozdmc+odm
if found()
   sele 1
   repl &ozdm with i->nr
else
set exact off
   seek ozdmc
   if found()
     do dmgd
   else
      appe blan
      repl zd with ozdm,dm with odm
      @ 21,20 say '─┌╚▌:' get nr
      read
      sele 1
      repl &ozdm with i->nr
   endif
endif
@ 21,1 say space(78)
set color to w+/1,,
sele 1
set exac off
return
****************
*   ┤·┬δ╣÷╢»   *
****************
proc dmgd
set color to w/1,,
@ 23,1 say space(78)
@ 23,13 say 'íⁿí²╝ⁿ:╖¡╢»┤·┬δ▒φ  ╗╪│╡╝ⁿ:╤í╘±╡▒╟░┤·┬δ  PgDn:╠ε╨┤╨┬┤·┬δ'
set color to 7/1,1/7,
priv ok,ol
ol=recn()
set color to w+/r,,
@ 21,1 say '╩Σ╚δ┤·┬δ:'
do while .t.
@ 21,11 say odm pict '!!!!!!!!'
@ 21,20 say '─┌╚▌:' get nr
clear get
ok=inkey(0)
do case
case ok=24
skip
if eof()
goto ol
endif
if zd<>ozdm
goto ol
endif
case ok=5
skip -1
if bof()
goto ol
endif
if zd<>ozdm
goto ol
endif
case ok=13
sele 1
repl &ozdm with i->nr
exit
case ok=3
appe blan
repl zd with ozdm,dm with odm
@ 21,20 say '─┌╚▌:' get nr
read
sele 1
repl &ozdm with i->nr
exit
endcase
enddo
set color to w/1,,
@ 23,1 say space(78)
@ 23,16 say '^End:═╦│÷ ^Home:╧╘╩╛╣ª─▄▓╦╡Ñ ^PgUp:╜°╚δ╡τ╫╙▒¿▒φ '
set color to 7/1,1/7,
return
****************
*   ╣½╩╜╝╞╦π   *
****************
proc js
priv o,ozdm,ojs,ol,oh
set color to w+/1,0/w,
sele 10
o=recn()
goto top
do while .not.eof()
ozdm=trim(╫╓╢╬├√)
ojs=trim(╦π)
oh=╨╨+2
ol=┴╨+2
sele 1
if len(ojs)>0
repl &ozdm with &ojs
@ oh,ol say &ozdm
endif
sele 10
skip
enddo
sele 10
goto o
sele 1
return

****************
*   ╩Σ╚δ╣½╩╜   *
****************
proc gs
priv ox,o,ocr,osq,ozf,ohz,ozdm,ol,obj,ojsgs
set color to 0/3,,
@ 23,1 say space(78)
@ 23,18 say '^End:═╦│÷ íⁿí²:╥╞╢»╫╓╢╬╣Γ▒Ω ╗╪│╡╝ⁿ:╤í╘±╫╓╢╬'
set color to w+/r,,
obj=chr(160)
ohz=0
ozf=''
ocr=1
ox=1
sele 10
ol=recn()
ozdm=trim(╫╓╢╬├√)
@ 1,40 say '╜ß╣√╫╓╢╬:'+ozdm
@ 1,60 say '╨▐╕─'
ojsgs=╦π
set color to 0/w,,
@ 21,1 say space(78)
@ 21,1 say ojsgs
sele 2
do while .t.
set color to 0/w,,
@ 21,ox say ''
o=inkey(0)
do case
case o=19.and.ox>1
ox=ox-1
if subs(ojsgs,ox,1)>obj
ox=ox-1
endif
loop
case o=4.and.ox<78
ox=iif(subs(ojsgs,ox,1)>obj,ox+2,ox+1)
loop
case o<127.and.o>31
ozf=iif(subs(ojsgs,ox,1)>obj.and.ocr=1,chr(o)+' ',chr(o))
if ocr=0
if len(trim(ojsgs))+len(ozf)<79
ojsgs=left(stuf(ojsgs,ox,0,ozf),78)
ox=iif(ox<78,ox+1,ox)
@ 21,1 say ojsgs
endif
else
ojsgs=stuf(ojsgs,ox,len(ozf),ozf)
@ 21,ox say ozf
ox=iif(ox<78,ox+1,ox)
endif
ohz=0
case o>160.and.ox<78
if ohz=0
ozf=chr(o)
ohz=1
else
ozf=ozf+chr(o)
ozf=iif(ocr=1.and.subs(ojsgs,ox,1)<obj.and.subs(ojsgs,ox+1,1)>obj,ozf+' ',ozf)
if ocr=0
if len(trim(ojsgs))+len(ozf)<79
ojsgs=left(stuf(ojsgs,ox,0,ozf),78)
@ 21,1 say ojsgs
ox=iif(ox<77,ox+2,ox)
endif
else
ojsgs=stuf(ojsgs,ox,len(ozf),ozf)
@ 21,ox say ozf
ox=iif(ox<77,ox+2,ox)
endif
ohz=0
endif
case o=22
ocr=iif(ocr=0,1,0)
@ 1,60 say iif(ocr=0,'▓σ╚δ','╨▐╕─')
case o=7
ojsgs=iif(subs(ojsgs,ox,1)<obj,stuf(ojsgs,ox,1,'')+' ',stuf(ojsgs,ox,2,'')+'  ')
@ 21,1 say ojsgs
case o=127.and.ox>1
ox=ox-1
if subs(ojsgs,ox,1)>obj
ox=ox-1
endif
ojsgs=iif(subs(ojsgs,ox,1)<obj,stuf(ojsgs,ox,1,'')+' ',stuf(ojsgs,ox,2,'')+'  ')
@ 21,1 say ojsgs
case o=13
keyb chr(24)
sele 10
ozdm0=iif(╟°='A',trim(╫╓╢╬├√),╟°+'->'+trim(╫╓╢╬├√))
if len(trim(ojsgs))+len(ozdm0)<79
ojsgs=left(stuf(ojsgs,ox,0,ozdm0),78)
@ 21,1 say ojsgs
ox=ox+len(ozdm0)
ox=iif(ox>78,78,ox)
endif
case o=23
sele 10
goto ol
repl ╦π with ojsgs
exit
case o=24
sele 10
set color to w+/1,,
@ ╨╨+2,┴╨+2 say space(╫╓╢╬│ñ╢╚)
if .not.eof()
skip
endif
if eof()
goto top
endif
set color to w+/r,,
@ ╨╨+2,┴╨+2 say space(╫╓╢╬│ñ╢╚)
case o=5
sele 10
set color to w+/1,,
@ ╨╨+2,┴╨+2 say space(╫╓╢╬│ñ╢╚)
if .not.bof()
skip -1
endif
if bof()
goto bott
endif
set color to w+/r,,
@ ╨╨+2,┴╨+2 say space(╫╓╢╬│ñ╢╚)
endcase
enddo
set color to w+/1,,
@ 1,40 say space(39)
@ 21,1 say space(78)
set color to w/1,,
@ 23,1 say space(78)
@ 23,16 say '^End:═╦│÷ ^Home:╧╘╩╛╣ª─▄▓╦╡Ñ ^PgUp:╜°╚δ╡τ╫╙▒¿▒φ '
set color to 7/1,1/7,
return

************
* ╡τ╫╙▒¿▒φ *
************
proc brow
set date ansi
set safe off
set color to ,0/3,
priv ozdszd,wzd,ozdmm(20),ozd0,zhzd,ozdczd,ozdx(20),zds,y,y0,sjl,wybz
priv ozdsd,ozdsdc,ozdszd,ozj,y1,objfx
objfx=.t.
dime ozdmm(20),ozdx(20)
if file('&wjm..bro')
rest from &wjm..bro addi
else
ozdszd=1
ozdsdc=0
ozdsd=0
ozdszd=1
ozd0=0
endif
ozj=.f.
wybz=.f.
sele 1
sjl=recn()
y=6
zds=1
zhzd=0
sele 10
use
sele 9
use brow.lby alia i
zap
appe from &wjm..olr
dele for ╟°<>'A'.or.╫╓╢╬│ñ╢╚>74.or.╫╓╢╬└α╨═='M'.or.╫╓╢╬└α╨═='L'
pack
zhzd=recc()
sele 10
use &wjm..olr alia j
sele 9
goto top
do while .not.eof()
zdsmcd=len(trim(╫╓╢╬╦╡├≈))
do case
case zdsmcd<=╫╓╢╬│ñ╢╚
repl sm2 with space(int((╫╓╢╬│ñ╢╚-zdsmcd)/2))+trim(╫╓╢╬╦╡├≈)
case zdsmcd<=╫╓╢╬│ñ╢╚*2
zd1cd=int(zdsmcd/2)+mod(int(zdsmcd/2),2)
zd2cd=zdsmcd-zd1cd
repl sm1 with space(int((╫╓╢╬│ñ╢╚-zd1cd)/2))+left(╫╓╢╬╦╡├≈,zd1cd)
repl sm3 with space(int((╫╓╢╬│ñ╢╚-zd2cd)/2))+subs(╫╓╢╬╦╡├≈,zd1cd+1,zd2cd)
othe
zdsmcd=iif(zdsmcd>╫╓╢╬│ñ╢╚*3,╫╓╢╬│ñ╢╚*3,zdsmcd)
zd1cd=int(zdsmcd/3)+mod(int(zdsmcd/3),2)
zd3cd=zdsmcd-(zd1cd*2)
repl sm1 with space(int((╫╓╢╬│ñ╢╚-zd1cd)/2))+left(╫╓╢╬╦╡├≈,zd1cd)
repl sm2 with space(int((╫╓╢╬│ñ╢╚-zd1cd)/2))+subs(╫╓╢╬╦╡├≈,zd1cd+1,zd1cd)
repl sm3 with space(int((╫╓╢╬│ñ╢╚-zd3cd)/2))+subs(╫╓╢╬╦╡├≈,zd1cd*2+1,zd3cd)
endcase
skip
enddo
load hbk
set color to w/1,,
clear
@ 24,0 say ''
call hbk with '00002479Z'
@ 1,2 say '╝╟┬╝║┼:           ╝╟┬╝╫▄╩²:'
sele 1
@ 1,col() say recc() pict '@B'
@ 2,1 say repl('⌐Ñ',39)
@ 22,1 say repl('⌐Ñ',39)
@ 23,2 say 'PgUp/PgDn:╟░║≤╖¡╥│  ^PgUp/^PgDn:╫≤╙╥╖¡╥│  ^Home:╣ñ╛▀▓╦╡Ñ  Esc:═╦│÷'
do dqysd
do dqy
**************
* ╓≈  ╤¡  ╗╖ *
**************
on key=21 do p4
goto top
do xsdqy
do xsjlh
zdmc=ozdmm(zds)
y=6
do while .t.
do while .t.
set color to 0/3,0/3,
@ y,ozdx(zds)-1 say ' '
@ y,ozdx(zds) get &zdmc
@ y,col() say ' '
read
if zds=1
   owy=.f.
   do wyxjc with &ozdm
   if owy
      exit
   endif
else
   exit
endif
?? chr(7)
enddo

ok=mod(read(),256)
set color to w/1,,
@ y,ozdx(zds)-1 say ' '
@ y,ozdx(zds) say &zdmc pict '@z'
yhx=str(col(),2)
@ y,col() say ' '
@ 24,0 say ''
call hbk with str(y,2)+str(ozdx(zds)-1,2)+yhx+'03a'
call hbk with str(y,2)+yhx+str(y,2)+'03p'
do case
case ok=0.or.ok=2
do zyzd
case ok=1.or.ok=3
do yyzd
case ok=4
do syyh
case ok=5
do xyyh
case ok=15
if objfx
do yyzd
else
do xyyh
endif
case ok=6.and.sjl>1
do sfyy
case ok=7.and..not.wybz
do xfyy
case ok=34.and.ozdszd>1
do zyck
case ok=35.and.ozd0<zhzd
do yyck
case ok=33
do gjcd
case ok=12.or.ok=14
save to &wjm..bro all like ozd*
return
endcase
enddo
return
************
* ╙╥╥╞╫╓╢╬ *
************
proc yyzd
if zds<ozd0
zds=zds+1
zdmc=ozdmm(zds)
else
zds=1
zdmc=ozdmm(zds)
do xyyh
endif
return
************
* ╫≤╥╞╫╓╢╬ *
************
proc zyzd
if zds>1
zds=zds-1
zdmc=ozdmm(zds)
endif
return
************
* ╙╥╥╞┤░┐┌ *
************
proc yyck
ozdszd=ozdszd+1
@ 3,ozdsdc+2 clear to 21,77
ojl=recn()
y0=y
do dqy
do xsdqy
goto ojl
y=y0
do zyzd
zdmc=ozdmm(zds)
return
************
* ╫≤╥╞┤░┐┌ *
************
proc zyck
ozdszd=ozdszd-1
@ 3,ozdsdc+2 clear to 21,77
y0=y
ojl=recn()
do dqy
do xsdqy
goto ojl
y=y0
do yyzd
zdmc=ozdmm(zds)
return

************
* ╧┬╖¡╥╗╥│ *
************
proc xfyy
goto sjl
skip 16
if eof()
wybz=.t.
skip -16
endif
sjl=recn()
do xsdqy
zdmc=ozdmm(zds)
y=6
do xsjlh
return

************
* ╔╧╖¡╥╗╥│ *
************
proc sfyy
goto sjl
skip -16
if bof()
goto top
endif
sjl=recn()
do xsdqy
y=6
wybz=.f.
zdmc=ozdmm(zds)
do xsjlh
ozj=.f.
return

************
* ╧┬╥╞╥╗╨╨ *
************
proc xyyh
if y<21
y=y+1
skip
if eof()
do zjjl
endif
else
skip
if eof()
do zjjl
if ozj
do xsdh
endif
else
sjl=sjl+1
do xsdh
endif
endif
do xsjlh
return
************
* ╔╧╥╞╥╗╨╨ *
************
proc syyh
if y>6
y=y-1
skip -1
else
skip -1
if bof()
goto top
else
sjl=recn()
do xssh
endif
endif
do xsjlh
ozj=.f.
return
**************
* ╧╘╩╛╡▒╟░╥│ *
**************
proc xsdqy
priv ojl
sele 1
goto sjl
y=6
do while y<22
do xsyh with y
@ 24,0 say ''
call hbk with str(y,2)+'027703A'
sele 1
if .not.eof()
skip
endif
y=y+1
enddo
sele 1
goto sjl
zd0=1
zdmc=ozdmm(zds)
return
************
* ╧╘╩╛╥╗╨╨ *
************
proc xsyh
para y
priv zd0
zd0=1
@ y,2 say ''
do while zd0<=ozd0
ozd=ozdmm(zd0)
sele 1
@ y,ozdx(zd0) say &ozd pict '@z'
zd0=zd0+1
enddo
return
************
* ╧╘╩╛╡╫╨╨ *
************
proc xsdh
priv zd0
call hbk with '06022177T'
zd0=1
@ 21,2 say ''
do while zd0<=ozd0
ozd=ozdmm(zd0)
sele 1
@ 21,ozdx(zd0) say &ozd pict '@z'
yhx=str(col(),2)
@ 24,0 say ''
call hbk with '21'+yhx+'2103p'
zd0=zd0+1
enddo
call hbk with '21772103p'
call hbk with '21027703a'
return
************
* ╧╘╩╛╩╫╨╨ *
************
proc xssh
priv zd0
call hbk with '06022177U'
zd0=1
@ 6,2 say ''
do while zd0<=ozd0
ozd=ozdmm(zd0)
sele 1
@ 6,ozdx(zd0) say &ozd pict '@Z'
yhx=str(col(),2)
@ 24,0 say ''
call hbk with '06'+yhx+'0603p'
zd0=zd0+1
enddo
call hbk with '06770603p'
call hbk with '06027703a'
return
*************
* ▓╦╡Ñ╧╘╩╛ *
************
proc cdxs
para cdx
priv oi
set color to w/1,,
@ 1,1 clear to 1,78
set color to 0/w,,
@ 1,5 say space(cdx*10)
@ 24,0 say ''
call hbk with '010501'+str(cdx*10+4,2)+'f'
oi=1
do while oi<=cdx
@ 1,oi*10-4 say tx(oi)
@ 24,0 say ''
call hbk with '01'+str(oi*10-5,2)+'01'+str(oi*10+4,2)+'D'
oi=oi+1
enddo
return
**************
* ╧╘╩╛╝╟┬╝║┼ *
**************
proc xsjlh
sele 1
set color to w/1,,
@ 1,9 say recn() pict '@b'
@ 1,46 say iif(dele(),'╔╛│²','    ')
return
************
* ╣ñ╛▀▓╦╡Ñ *
************
proc gjcd
set esca off
PRIV TX(8),o,oi,ok,y0
set safe off
oi=1
DIME TX(8)
TX(1)='╬─╝■╢Ñ▓┐'
TX(2)='╬─╝■╬▓▓┐'
TX(3)='╓╕╢¿╝╟┬╝'
TX(4)='╔╛│²╥╗╨╨'
TX(5)='▓σ╚δ╥╗╨╨'
TX(6)='╫╓╢╬╦°╢¿'
TX(7)='▒α╝¡╖╜╧≥'
@ 24,79 SAY ''
set color to 0/3,0/3,
@ y,ozdx(zds)-1 say ' '
@ y,ozdx(zds) get &zdmc
@ y,col() say ' '
clear get
o=0
do menu with 7
if o>0
o=str(o,1)
do p&o
endif
set color to w/1,,
@ 1,1 say space(78)
call hbk with '00017801A'
call hbk with '02017801B'
@ 1,2 say '╝╟┬╝║┼:           ╝╟┬╝╫▄╩²:'
sele 1
@ 1,col() say recc() pict '@b'
do xsjlh
return
************
* ╬─╝■╢Ñ▓┐ *
************
proc p1
sele 1
goto top
sjl=recn()
set color to w/1,,
do xsdqy
y=6
return
************
* ╬─╝■╬▓▓┐ *
************
proc p2
sele 1
goto bott
skip -15
if bof()
goto top
endif
sjl=recn()
set color to w/1,,
do xsdqy
y=6
return
************
* ▒α╝¡╖╜╧≥ *
************
proc p7
objfx=iif(objfx,.f.,.t.)
return
************
* ╓╕╢¿╝╟┬╝ *
************
proc p3
set color to w/1,0/3,
@ 1,55 say '╓╕╢¿╝╟┬╝:' get sjl pict '9999999999' rang 1,recc()
read
set color to w/1,,
do xsdqy
y=6
return
************
* ╔╛│²╥╗╨╨ *
************
proc p4
sele 1
if dele()
reca
else
dele
endif
set color to w/1,,
@ 1,46 say iif(dele(),'╔╛│²','    ')
return
************
* ▓σ╚δ╥╗╨╨ *
************
proc p5
priv y0
sele 1
inse blan befo
set color to w/1,,
y0=y
do xsdqy
skip y0-6
y=y0
return
************
* ╫╓╢╬╦°╢¿ *
************
proc p6
set color to w/1,0/3,
@ 1,55 say '╦°╢¿╫╓╢╬╩²:' get ozdsd pict '9999999999'
read
if ozdsd<1.or.ozdsd>ozd0-1
ozdsd=0
endif
sele 9
loca for ozdmm(ozdsd+1)=╫╓╢╬├√
ozdszd=recn()
ozdsdc=ozdx(ozdsd+1)-3
return
**************
* ╝╞╦π╡▒╟░╥│ *
**************
proc dqy
sele 9
ozdzcd=ozdsdc
goto ozdszd
wzd=ozdszd
ozd0=ozdsd
set color to 3/1,,
do while wzd<=zhzd
if ozdzcd+╫╓╢╬│ñ╢╚+2<78
ozd0=ozd0+1
ozdx(ozd0)=ozdzcd+3
@3,ozdx(ozd0) say trim(sm1)
@4,ozdx(ozd0) say trim(sm2)
@5,ozdx(ozd0) say trim(sm3)
ozdzcd=ozdzcd+╫╓╢╬│ñ╢╚+2
ozdmm(ozd0)=╫╓╢╬├√
wzd=recn()
@ 24,0 say ''
if ozdzcd<76
call hbk with '03'+str(ozdzcd+1,2)+'2103p'
endif
else
exit
endif
skip
if eof()
exit
endif
enddo
call hbk with '03012103p'
call hbk with '03772103p'
call hbk with '05027703a'
call hbk with '03027703b'
call hbk with '21027703a'
set color to w/1,,
return
************
* ╝╞╦π╦°╢¿ *
************
proc dqysd
priv sd
set color to 3/1,,
sd=1
sele 9
do while sd<=ozdsd
loca for ozdmm(sd)=trim(╫╓╢╬├√)
@3,ozdx(sd) say trim(sm1)
@4,ozdx(sd) say trim(sm2)
@5,ozdx(sd) say trim(sm3)
@ 24,0 say ''
call hbk with '03'+str(ozdx(sd+1)-2,2)+'2103p'
sd=sd+1
enddo
return
************
* ╫╖╝╙╝╟┬╝ *
************
proc zjjl
priv ok,olsbl(128)
dime OLSBL(128)
sele 1
if ofz
   goto bott
   scat to olsbl
endif
if .not.ozj
@ 1,56 say '╩╟╖±╫╖╝╙╨┬╝╟┬╝?(Y/N)'
ok=abs(inkey(0))
@ 1,56 say '                    '
ozj=chr(ok)$'Yy'
endif
if ozj
appe blan
if ofz
   gath from olsbl
endif
sjl=sjl+1
else
goto bott
if y<21
y=y-1
endif
endif
sele 1
@ 1,29 say recc() pict '@b'
return
************
* ═¿╙├▓╦╡Ñ *
************
proc menu
para cdx
do cdxs with cdx
oi=1
do while .t.
set color to w+/3,,
@ 1,oi*10-5 say ' '+tx(oi)+' '
@ 24,0 say ''
call hbk with '01'+str(oi*10-5,2)+'01'+str(oi*10+4,2)+'C'
OK=INKEY(0)
set color to 0/w,,
@ 1,oi*10-5 say ' '+tx(oi)+' '
@ 24,0 say ''
call hbk with '01'+str(oi*10-5,2)+'01'+str(oi*10+4,2)+'D'
do case
case ok=19.or.ok=5
oi=iif(oi>1,oi-1,cdx)
case ok=4.or.ok=24
oi=iif(oi<cdx,oi+1,1)
case ok=13
o=oi
exit
case ok=27
o=0
exit
endcase
enddo
set color to w/1,,
@ 1,1 say space(78)
call hbk with '00017801A'
call hbk with '02017801B'
@ 1,2 say '╝╟┬╝║┼:           ╝╟┬╝╫▄╩²:'
sele 1
@ 1,col() say recc() pict '@b'
do xsjlh
return
**************
* ╬¿╥╗╨╘╝∞▓Θ *
**************
proc wyxjc
para ojczd
priv ol
sele 8
seek ojczd
if found()
owy=.f.
sele 1
return
endif
sele 1
ol=recn()
goto top
loca for &owyzd=ojczd
if recn()=ol
cont
else
owy=.f.
goto ol
return
endif
if found()
owy=.f.
goto ol
return
endif
owy=.t.
goto ol
return

*******************************************************
* ▒α│╠╚╒╞┌: 93.12.21   21:26:28
*******************************************************