home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / UPNDOWN.PRG < prev    next >
Encoding:
Text File  |  1991-06-06  |  4.0 KB  |  115 lines
  1. /*
  2.     Program: UP_N_DOWN()
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.x Version
  7.     Compile instructions: clipper upndown /n/w/a
  8.     Special thanks to Greg Smith and Dennis Levin for their input!
  9.  
  10.     Flexible upper and lower case data entry -- for example, if
  11.     you have one field for the entire name (first and last),
  12.     this will automatically make each name proper (first letter
  13.     upper, rest lower).
  14. */
  15.  
  16. //───── begin preprocessor directives
  17.  
  18. #include "inkey.ch"
  19.  
  20. //───── end preprocessor directives
  21.  
  22. function up_n_down(cstring)
  23. local mrow := row(), mcol := col(), key := 0, mkey, ;
  24.       origvar := cstring, ;        // save original value in case of ESC
  25.       ret_val := replicate('X', len(cstring)), ;  // the picture clause
  26.       nlength := len(cstring), ;   // set maximum length for data entry
  27.       nextupper := .t.             // first character must be upper-case
  28. GFSaveEnv()
  29. setcolor(substr(setcolor(), at(',', setcolor()) + 1))  // sneaky sneaky
  30. @ mrow, mcol say cstring                               // initial display
  31. cstring := []
  32.  
  33. /*
  34.   begin main loop
  35.  
  36.   we simulate an actual read by allowing the following active keys:
  37.   enter,  esc,  ctrl-w,  uparrow, downarrow, pgup, and pgdn
  38.  
  39.   if you want to limit escape from this routine, it is a simple
  40.   matter to remove the desired key values from the next statement
  41.  
  42.   note also that we fall out of the loop when nlength reaches 0.  this
  43.   effectively simulates set confirm off.
  44. */
  45.  
  46. do while key != K_ENTER .and. key != K_ESC .and. key != K_CTRL_W .and. ;
  47.          key != K_UP .and. key != K_DOWN .and. key != K_PGUP .and.     ;
  48.          key != K_PGDN .and. nlength > 0
  49.    @ mrow, mcol say cstring picture ret_val
  50.    key := ginkey(0)
  51.    do case
  52.  
  53.       //───── user pressed an alphanumeric or punctuation key
  54.       case (key > 32 .and. key < 91) .or. (key > 96 .and. key < 123)
  55.          //───── if this is an alpha, we must do additional testing
  56.          mkey := chr(key)
  57.          if key > 64
  58.             if nextupper
  59.                //───── if the next character should be upper but they entered
  60.                //───── an upper, switch case to lower: huh?  this is so that
  61.                //───── someone could enter, for example, "dBASE"
  62.                if key < 91
  63.                   mkey := chr(key + 32)
  64.                //───── force upper-case if called for
  65.                else
  66.                   mkey := chr(key - 32)
  67.                endif
  68.             endif
  69.          endif
  70.          cstring += mkey
  71.          nextupper := .f.
  72.          nlength--             // decrement the length counter
  73.  
  74.       case key == 32
  75.          nextupper := .t.      // next character will be uppercase
  76.          cstring += [ ]
  77.          nlength--             // decrement the length counter
  78.  
  79.       case key == K_BS .and. len(cstring) > 0
  80.          cstring := substr(cstring, 1, len(cstring) - 1)
  81.          //───── clear last character the easy way
  82.          scroll(mrow, col()-1, mrow, col()-1, 0)
  83.          //───── if we are at a space or back at the beginning of the
  84.          //───── string, next character must be uppercase
  85.          nextupper := (substr(cstring, len(cstring)) = chr(32) .or. ;
  86.                        len(cstring) = 0)
  87.          nlength++      // increment the length counter
  88.  
  89.    endcase
  90. enddo
  91.  
  92. do case
  93.    //───── reset CSTRING to its original value
  94.    case key == K_ESC
  95.       cstring := origvar
  96.       keyboard chr(K_ENTER)
  97.    //───── entered max number of characters - stuff enter to continue
  98.    case nlength == 0
  99.       keyboard chr(K_ENTER)
  100.    //───── any other key -- stuff it into buffer to be acted upon properly
  101.    otherwise
  102.       keyboard chr(key)
  103. endcase
  104.  
  105. //───── restore environment to previous state
  106. GFRestEnv()
  107. //───── pad the string back to its original length
  108. cstring := padr(cstring, len(ret_val))
  109. return ret_val
  110.  
  111. * end function Up_N_Down()
  112. *--------------------------------------------------------------------*
  113.  
  114. * eof upndown.prg
  115.