Liren Large Software Subsidy 5/05.iso/a/a001/1.ddi/ZWH.PRG

Text File | 1993-04-25 | 5.4 KB | 249 lines

* ⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤
* ⌐ª ú╤ú┴ú═  ú╓ú▓.ú░       ┐∞╦┘▓╦╡Ñ╫╘╢»╔·│╔╣ñ╛▀         ⌐ª
* ⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝
* ▒Σ┴┐║═╩╣╙├╦╡├≈:
*     _begin  ╘┌╩²╛▌╬─╝■┐¬╩╝╡─╬╗╓├.
*     statu  ▓╦╡Ñ╫┤╠¼.
*     cc     ╝ⁿ╓╡.
*     wflag  ▓╦╡Ñ╨┤╫┤╠¼, ╬¬ 0 ╘≥╨┤, ╬¬ 1 ╘≥▓╗╨┤
*     _EXIT  ╟σ╞┴▓ó╖╡╗╪╡┌╥╗╝╢▓╦╡Ñ.  ╚▒╩í╓╡╬¬ 255
*
SET TALK OFF
SET STAT OFF
SET ECHO OFF
SET SCOREBOARD OFF
clear all
*=======================================
*     ╤í╘≥╡┌ 8 ╟°, ┤≥┐¬╩²╛▌╬─╝■
if .not.FILE("zwh.DAT")
   ? "├╗╙╨ QAM ╩²╛▌╬─╝■ zwh.DAT"
   return
endif
Mselect = '8'
select &Mselect
use zwh.DAT
_EXIT = 255
set procedure to zwh
cc    = _EXIT
do s0_m0 with cc
set procedure to
clear all
set colo to
clear

*=======================================
PROCEDURE s0_m0
parameters cc
private statu,_begin,statu,wflag
_begin = 1
goto _begin
s00 = x
statu = 0
wflag = 0
cc    = _EXIT
DO WHILE .T.
   if cc = _EXIT
      set  colo to 0/7
      wflag = 0
      statu = 0
      CLEAR
   endif
   do PRGMENU with cc,s00,_begin,statu,wflag
   wflag = 1
   if cc = 27 .and. statu = 0
      return
   endif
  do case
     case s00 = 1
*         ╩² ╛▌ ╣▄ └φ
          if cc = 13
             do MENU1
             cc = _EXIT
          else
             cc = 0
          endif
*         wflag = 0
     case s00 = 2
*         ╬█ ╚╛ ╘┤ ╞└╝█
          if cc = 13
             do MENU2
             cc = _EXIT
          else
             cc = 0
          endif
*         wflag = 0
     case s00 = 3
*         ╦« ╓╩ ─ú ─Γ
          if cc = 13
             do MENU3
             cc = _EXIT
          else
             cc = 0
          endif
*         wflag = 0
     case s00 = 4
*         ╚▌ ┴┐ ╝╞ ╦π
          if cc = 13
             do MENU4
             cc = _EXIT
          else
             cc = 0
          endif
*         wflag = 0
     case s00 = 5
*          ╚▌ ┴┐ ╖╓ ┼Σ
          if cc = 13
             do MENU5
             cc = _EXIT
          else
             cc = 0
          endif
*         wflag = 0
  endcase
  if cc = 27
     statu = 0
  endif
enddo
goto _begin
repl x with s00
return

* ⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤
* ⌐ª  ú╤ú┴ú═  ╣½╙├╣²│╠╬─╝■ prgmenu.prg  ⌐ª
* ⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝
*========================================
PROCEDURE prgmenu
parameters  cc,choice,_begin,statu,wflag

goto _begin

Mmin = 1
Mmax = y
Mlen = x1
Mtype = y1
fcolor = left(name,10)
bcolor = substr(name,11,10)
pcolor = substr(name,21,10)
winclr = trim(left(pname,20))
shadow = trim(substr(pname,21,20))
winbox = trim(substr(pname,41,30))

if wflag = 0
   if len(shadow) # 0
      set color to
      @ &shadow
   endif
   set color to  &bcolor
   if len(winclr) # 0
      @ &winclr
   endif
   if len(winbox) # 0
      ! ccbox &winbox
   endif
   set colo to &fcolor
   goto _begin + 1
   sn =  1
   do while  ( sn <= Mmax )
      sn = sn + 1
      @ y,x say left(name,Mlen)
      skip
   enddo
   goto choice + _begin
   set colo to &pcolor
   @ y,x say left(name,Mlen)
   if len(trim(pname)) # 0
      set colo to &fcolor
      @ y1,x1 say left(pname,78-x1)
      pps = 1
   endif
else
   goto choice + _begin
endif

do while .T.
   if cc # 4 .and.  cc # 19
      cc = 0
      do while cc = 0
         cc = inkey(60)
      enddo
   endif
   if Mtype = 0
      do case
         case cc = 13
              return
         case cc = 27 .or. cc = 19 .or. cc = 4
              set color to  0/7
              if len(trim(pname)) # 0
                 @ y1,x1 say space(78-x1)
              endif
              if len(shadow) # 0
                 @ &shadow
              endif
              if len(winclr) # 0
                 @ &winclr
              endif
              return
         case cc = 5
              choice = choice - 1
              if choice < Mmin
                 choice = Mmax
              endif
         case cc = 24
              choice = choice + 1
              if choice > Mmax
                 choice = 1
              endif
      endcase
   else
      do case
         case cc = 13
              statu = 1
              return
         case cc = 27
              if statu = 1
                 statu = 0
                 cc = 0
              else
                 set color to  0/7
                 if len(trim(pname)) # 0
                    @ y1,x1 say space(78-x1)
                 endif
                 if len(shadow) # 0
                    @ &shadow
                 endif
                 if len(winclr) # 0
                    @ &winclr
                 endif
              endif
              return
         case cc = 19
              choice = choice - 1
              if choice < Mmin
                 choice = Mmax
              endif
         case cc = 4
              choice = choice + 1
              if choice > Mmax
                 choice = 1
              endif
      endcase
   endif
   set colo to &fcolor
   @ y,x say left(name,Mlen)
   if len(trim(pname)) # 0
      @ y1,x1 say space(78-x1)
   endif
   goto choice + _begin
   set colo to &pcolor
   @ y,x say left(name,Mlen)
   if len(trim(pname)) # 0
      set colo to &fcolor
      @ y1,x1 say left(pname,78-x1)
   endif
   if statu = 1
      return
   endif
   cc = 0
enddo
return