home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / COLE.ZIP / GET_TST.PRG < prev    next >
Encoding:
Text File  |  1990-05-27  |  2.5 KB  |  122 lines
  1. set scoreboard off
  2. colSTR  = "+w/b,n/w,,,n/w"
  3. colCHC  = "+gr/bg,+w/r,,,+n/bg"
  4. colCHCX = "n/bg"
  5.  
  6. setcolor( colstr)
  7. clear
  8.  
  9. var1 = space(3)
  10. var2 = space(1)
  11. var3 = space(3)
  12.  
  13. @  5, 0 say "Var1: " get var1 valid ( temp() )
  14. @  6, 0 say "Var2: " get var2 when ( myUdf( @var2) )
  15. @  7, 0 say "Var3: " get var3
  16.  
  17. read
  18.  
  19.  
  20. *------------------------*
  21. function temp
  22.     local oldgets
  23.     static var4, var5
  24.  
  25.     oldgets := Getlist
  26.  
  27.     Getlist := {}
  28.  
  29.     if valtype( VAR4) != "C"
  30.         var4 := space(5)
  31.     endif
  32.  
  33.     if valtype( VAR5) != "C"
  34.         var5 := space(5)
  35.     endif
  36.  
  37.     @ 10, 40 say "Nested Gets:"
  38.  
  39.     @ 11, 40 say "Var4: " get var4
  40.     @ 12, 40 say "Var5: " get var5
  41.     read
  42.  
  43.     Getlist := oldgets
  44.  
  45. return .t.
  46.  
  47. *------------------------*
  48. function myUdf( tmpvar)
  49.    local ans
  50.  
  51.    declare la_choices[3]
  52.    la_choices[1] = "Choice 1"
  53.    la_choices[2] = "Choice 2"
  54.    la_choices[3] = "Choice 3"
  55.  
  56.    ans = ach_wndw( la_choices, " Select One ",,,, "achudf" )
  57.  
  58.    if ans != 0
  59.        tmpvar := alltrim( str( ans))
  60.    endif
  61.  
  62. return .t.
  63.  
  64. *------------------------*
  65. function AchUdf( status)
  66.  
  67.     local lastkey, ret_val
  68.  
  69.     lastkey := lastkey()
  70.  
  71.     do case
  72.         case lastkey == 13 /* a selection has been made */
  73.             keyboard chr(13)
  74.             ret_val := 1        /* done with achoice */
  75.         case status == 1        /* cursor past top of list */
  76.             keyboard chr(5)     /* stuff an up arrow to move to previous get */
  77.             ret_val := 0        /* abort selection process */
  78.         case lastkey == 27      /* ESC was pressed. Exit achoice */
  79.             keyboard chr(13)
  80.             ret_val := 0        /* abort selection process */
  81.         otherwise
  82.             ret_val := 2        /* continue selection process */
  83.     endcase
  84.  
  85. return ret_val
  86. *------------------------*
  87.  
  88. FUNCTION Center( char, width, row, clr)
  89.  
  90.    LOCAL length, ret_val, oldcolor
  91.  
  92.    IF valtype(WIDTH) != "N"
  93.       WIDTH = 80
  94.    ENDIF
  95.  
  96.    length = LEN(char)
  97.  
  98.    ret_val = IF( length < WIDTH, (WIDTH - length)/2, 0 )
  99.  
  100.    * If the 3rd parameter was passed, then print to current device
  101.    IF valtype(ROW) == "N"
  102.  
  103.  
  104.       * If 4th parameter was passed, then use that color
  105.       IF valtype(CLR) == "C"
  106.          oldcolor = SETCOLOR(clr)
  107.       ENDIF
  108.  
  109.       @ ROW, ret_val SAY char
  110.  
  111.       IF valtype(CLR) == "C"
  112.          SETCOLOR(oldcolor)
  113.       ENDIF
  114.  
  115.  
  116.    ENDIF
  117.  
  118. RETURN ret_val
  119. *---------------------------*
  120.  
  121.  
  122.