Liren Large Software Subsidy 5/05.iso/a/a056/4.ddi/MAIN/YQMIS022.PRG

Text File | 1993-11-01 | 21.4 KB | 1,303 lines

*******************************************************
* ╬─╝■├√│╞: YQMIS022
* │╠╨≥╔Φ╝╞: └ε▒■╥╗
* ▒α│╠╚╒╞┌: 93.11.01   22:24:37
*******************************************************
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
*set excl on
use ZWJT alia A
set proc to YQMIS022
priv ozdm,ogzq,oh,ol,ok,oj,otjbl
otjbl=space(78)
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:╜°╚δ╡τ╫╙▒¿▒φ '
@ 6,2 say '                             ╩Σ ╚δ ╓░ ╬± ╜≥ ╠∙'
@ 7,2 say '                       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
@ 9,2 say '                    ⌐│⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╫⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐╖'
@ 10,2 say '                    ⌐º╓░╬±:         ⌐º╓░╬±╜≥╠∙:       ⌐º'
@ 11,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 YQMIS022.olr alia j
wjm=left(sys(16),len(sys(16))-4)
sele 1
if recc()=0
appe blan
endif
do xs
sele 10
goto top
set color to w+/1,0/w,
do while .t.
   ozdm=trim(╫╓╢╬├√)
   ogzq=╟°
   ojg=╕─
   oh=╨╨+2
   ol=┴╨+2
   ocd=┤╩╡Σ
   sele 1
   if ogzq='A'.and..not.ojg
      @ oh,ol get &ozdm
      if ocd
         clea get
         ozdmc=ozdm
         do odm
      else
         read
      endif
      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
        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
        do smggp with '╒²╘┌┤µ┼╠,╟δ╔╘║≥!',10,31
        sele 1
        pack
        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,,
@ 1,9 say recn() pict '@B 99999999'
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
sele 1
if oj
   appe blan
   @ 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
      @ 1,29 say recc() pict '@B 99999999'
   else
      goto bott
   endif
endif
return

****************
*   ┬╝╚δ▓╦╡Ñ   *
****************
proc cd
priv o,tx(9)
dime tx(9)
sele 1
@ oh,ol get &ozdm
clear get
tx(1)='╓╕╒δ'
tx(2)='▓σ╚δ'
tx(3)='╔╛│²'
tx(4)='╜√╕─'
tx(5)='╝ñ╗ε'
tx(6)='┤·┬δ'
tx(7)='╣½╩╜'
tx(8)='╠⌡╝■'
tx(9)='╨▐╕─'
o=0
do menu with 9,6
set color to w+/1,,
do case
case o=1
     sele 1
     tx(1)='╬─╝■┐¬═╖'
     tx(2)='╬─╝■╬▓▓┐'
     tx(3)='╓╕╢¿╝╟┬╝'
     o=0
     do menu with 3,10
     do case
     case o=1
          goto top
     case o=2
          goto bott
     case o=3
          o=recn()
          @ 1,54 say '╝╟┬╝║┼:' get o rang 1,recc() pict '@B'
          read
          @ 1,54 say space(25)
          goto o
     endcase
     do xs
     sele 1
case o=2
     inse befor blan
     do xs
     sele 1
     set color to w+/1,,
     @ 1,29 say recc() pict '@B 99999999'
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
case o=8
     do tj
case o=9
     do xg
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
   appe blan
   repl zd with ozdm,dm with odm
   @ 21,20 say '─┌╚▌:' get nr
   read
   sele 1
   repl &ozdm with i->nr
endif
@ 21,1 say space(78)
set color to w+/1,,
sele 1
set exac off
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 w+/1,,
@ 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<80
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)<81
ojsgs=left(stuf(ojsgs,ox,0,ozf),80)
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<80,ox+1,ox)
endif
ohz=0
case o>160.and.ox<80
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<79,ox+2,ox)
endif
else
ojsgs=stuf(ojsgs,ox,len(ozf),ozf)
@ 21,ox say ozf
ox=iif(ox<79,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 0/3,,
@ 23,1 say space(78)
@ 23,16 say '^End:═╦│÷ ^Home:╧╘╩╛╣ª─▄▓╦╡Ñ ^PgUp:╜°╚δ╡τ╫╙▒¿▒φ '
set color to 7/1,1/7,
return
**************
*  ╩Σ╚δ╠⌡╝■  *
**************
proc tj
priv ox,o,ocr,osq,ozf,ohz,ozdm,ol,obj,ojsgs
ojsgs=otjbl
set color to w+/1,,
@ 23,1 say space(78)
@ 23,18 say '^End:═╦│÷ íⁿí²:╥╞╢»╫╓╢╬╣Γ▒Ω ╗╪│╡╝ⁿ:╤í╘±╫╓╢╬'
obj=chr(160)
ohz=0
ozf=''
ocr=1
ox=1
sele 10
goto top
set color to w+/r,,
@ ╨╨+2,┴╨+2 say space(╫╓╢╬│ñ╢╚)
ol=recn()
ozdm=trim(╫╓╢╬├√)
@ 1,60 say '╨▐╕─'
set color to 0/w,,
@ 21,1 say space(78)
@ 21,1 say ojsgs
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<79,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
ojsgs0=ojsgs
do zryy
oer=.f.
on erro oer=.t.
sele 1
set filt to &ojsgs
ojsgs=ojsgs0
goto top
if oer
set color to w+/r,,
@ 1,40 say '▓Θ╤»╠⌡╝■╙╨╬≤!!!'
ok=inkey(2)
set color to w/1,,
@ 1,40 say '               '
else
on erro
exit
endif
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
otjbl=ojsgs
set color to w+/1,,
@ 1,35 say space(44)
@ 21,1 say space(80)
call hj with '00007924'
set color to w+/1,,
set color to 7/1,1/7,
return
************
* │╔┼·╨▐╕─ *
************
proc xg
priv ojlh,ozdnr
@ oh,ol get &ozdm
read
ozdnr=&ozdm
ojlh=recn()
repl &ozdm with ozdnr all
goto ojlh
return
************
* ╫╘╚╗╙∩╤╘ *
************
proc zryy
priv zh,zrm(8,2),o,om
om=8
dime zrm(8,2)
zrm(1,1)='['
zrm(2,1)=']'
zrm(3,1)='╢°╟╥'
zrm(4,1)='╗≥╒▀'
zrm(5,1)='▓╗╡╚╙┌'
zrm(6,1)='╡╚╙┌'
zrm(7,1)='╨í╙┌'
zrm(8,1)='┤≤╙┌'
zrm(1,2)=[ctod(']
zrm(2,2)=[')]
zrm(3,2)='.and.'
zrm(4,2)='.or.'
zrm(5,2)='#'
zrm(6,2)='='
zrm(7,2)='<'
zrm(8,2)='>'
o=1
do while o<=om
do while .t.
zh=at(zrm(o,1),ojsgs)
if zh>0
ojsgs=stuf(ojsgs,zh,len(zrm(o,1)),zrm(o,2))
else
exit
endif
enddo
o=o+1
enddo
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
zhzd=recc()
dele for ╟°<>'A'.or.╫╓╢╬│ñ╢╚>74.or.╫╓╢╬└α╨═='M'.or.╫╓╢╬└α╨═='L'
pack
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.
set color to 0/3,0/3,
@ y,ozdx(zds)-1 say ' '
@ y,ozdx(zds) get &zdmc
@ y,col() say ' '
read
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.ozdszd<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 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
if .not.ozj
@ 1,56 say '╩╟╖±╫╖╝╙╨┬╝╟┬╝?(Y/N)'
ok=abs(inkey(0))
@ 1,56 say '                    '
ozj=chr(ok)$'Yy'
endif
if ozj
appe blan
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,cdk
do cdxs with cdx,cdk
oi=1
do while .t.
set color to w+/3,,
@ 1,(oi-1)*cdk+5 say ' '+tx(oi)+' '
@ 24,0 say ''
call hbk with '01'+str((oi-1)*cdk+5,2)+'01'+str(oi*cdk+4,2)+'C'
OK=INKEY(0)
set color to 0/w,,
@ 1,(oi-1)*cdk+5 say ' '+tx(oi)+' '
@ 24,0 say ''
call hbk with '01'+str((oi-1)*cdk+5,2)+'01'+str(oi*cdk+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 cdxs
para cdx,cdk
priv oi
set color to w/1,,
@ 1,1 clear to 1,78
set color to 0/w,,
@ 1,5 say space(cdx*cdk)
@ 24,0 say ''
call hbk with '010501'+str(cdx*cdk+4,2)+'f'
oi=1
do while oi<=cdx
@ 1,(oi-1)*cdk+6 say tx(oi)
@ 24,0 say ''
call hbk with '01'+str((oi-1)*cdk+5,2)+'01'+str(oi*cdk+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,10
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

*******************************************************
* ▒α│╠╚╒╞┌: 93.11.01   22:24:38
*******************************************************