home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / PSGET.ZIP / PW_PSGET.PRG
Encoding:
Text File  |  1988-11-08  |  3.3 KB  |  122 lines
  1. FUNC PseudoGet
  2. *** 
  3. *** PSEUDOGET
  4. *** (pw_psget)
  5. *** 
  6. *** Imitates a get/read for one variable; most useful for hotkey functions
  7. *** that require input while a read is already in effect.
  8. ***           
  9. *** Syntax:   PSEUDOGET( <expN1>, <expN2>, <expC1>, <expC1> )
  10. *** <expN1-2> Row and column position of field.
  11. *** <exp1>    Current value of field--character, numeric, logical and date
  12. ***           types are all supported.
  13. *** <expC2>   Picture clause; don't use spaces (use Xs instead), unless
  14. ***           you want forced spaces as a result in the returned value.
  15. ***           
  16. *** Returns:  new value of field
  17. ***           
  18. *** Requires: - GETKEY(), KEYCK()
  19. ***           
  20. *** Examples: - mvendno = PSEUDOGET(7,28,mvendno,'XXXXXX')
  21. ***           - mcompany = PSEUDOGET(9,28,SPACE(35), ;
  22. ***             'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX')
  23. *** 
  24. *** Notes:        - Note that this function creates a public variable called 
  25. ***                            PSEUDOGOT that is used to signal the calling program that a 
  26. ***                            PSEUDOGET() has been issued.  This is primarily to prevent 
  27. ***                            unwanted reads from occuring. 
  28. *** 
  29. ***                            As an example:    
  30. ***                                    IF TYPE("PSUEDOGOT")="U"        && In the calling program
  31. ***                                        READ
  32. ***                                    ELSE
  33. ***                                        RELEASE PSEUDOGOT
  34. ***                                    ENDIF
  35. *** 
  36. PARAMETERS mrow, mcol, mcurval, mpict
  37. DO CASE
  38. CASE TYPE('MCURVAL') = 'C'
  39.     mfield = mcurval
  40. CASE TYPE('MCURVAL') = 'N'
  41.     IF AT('.',mpict) <> 0
  42.         mdec = LEN(mpict)-AT('.',mpict)-1
  43.     ELSE
  44.         mdec = 0
  45.     ENDIF
  46.     mfield = STR(mcurval,LEN(mpict),mdec)
  47. CASE TYPE('MCURVAL') = 'L'
  48.     IF mpict = 'Y'
  49.         mfield = iif(mcurval,'Y','N')
  50.     ELSE
  51.         mfield = iif(mcurval,'T','F')
  52.     ENDIF
  53. CASE TYPE('MCURVAL') = 'D'
  54.     mfield = dtoc(mcurval)
  55. ENDCASE
  56. * ProWest 6/8/88 WFB 1:removed dependence on var m0ce_rev
  57. mcolor = setcolor(iif(TYPE('m0ce_rev')='C',m0ce_rev,'N/W,W/N'))
  58. @ mrow,mcol SAY SPACE(LEN(mpict))
  59. mpos = 1
  60. mKey = 1
  61. DO WHILE mpos > 0 .AND. mpos < LEN(mpict)+1
  62.     @ mrow,mcol SAY mfield
  63.     @ mrow,mcol+mpos-1 SAY ''
  64.     mKey = GetKey(0)
  65.     DO CASE
  66.     CASE mKey = 4
  67.         * right arrow
  68.         mpos = mpos + 1
  69.         LOOP
  70.     CASE mKey = 19
  71.         * left arrow
  72.         mpos = mpos - 1
  73.         LOOP
  74.     CASE mKey = 13 .OR. mKey = 24 .OR. mKey = 5 .OR. mKey = 18 ;
  75.         .OR. mKey = 3 .OR. mKey = 23 .OR. mKey = 27
  76.         * possible exit keys
  77.         EXIT
  78.     CASE mKey = 8
  79.         * backspace
  80.         mpos = mpos - 1
  81.         mfield = stuff(mfield,mpos,1,'')
  82.         mfield = mfield + ' '
  83.     CASE mKey = 7
  84.         * delete
  85.         mfield = stuff(mfield,mpos,1,'')
  86.         mfield = mfield + ' '
  87.     CASE mKey > 31 .AND. mKey < 255
  88.         * everything else
  89.         mfield = stuff(mfield,mpos,1,transform(CHR(mKey),SUBSTR(mpict,mpos,1)))
  90.         mpos = mpos + 1
  91.     OTHERWISE
  92.         LOOP
  93.     ENDCASE
  94. ENDDO
  95. SET COLOR TO &mcolor
  96. @ mrow,mcol SAY mfield
  97. DO CASE
  98. CASE TYPE('MCURVAL') = 'C'
  99.     mretval = mfield
  100. CASE TYPE('MCURVAL') = 'N'
  101.     IF AT('.',mpict) <> 0
  102.         mdec = LEN(mpict)-AT('.',mpict)-1
  103.     ELSE
  104.         mdec = 0
  105.     ENDIF
  106.     mretval = val(mfield) 
  107. CASE TYPE('MCURVAL') = 'L'
  108.     IF mpict = 'Y'
  109.         mretval = iif(mfield='Y',.T.,.F.)
  110.     ELSE
  111.         mretval = iif(mfield='T',.T.,.F.)
  112.     ENDIF
  113. CASE TYPE('MCURVAL') = 'D'
  114.     mretval = ctod(mfield)
  115. ENDCASE
  116. * ProWest 11/8/88 DLW 1:Added PseudoGot variable, see notes in func header
  117. RELEASE pseudogot
  118. PUBLIC pseudogot
  119. RETURN(mretval)
  120.  
  121. *****  Last Updated WFB 11/8/88 *****
  122. *****  122 Lines *****