home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR7 / FOXTAILS.ZIP / MKEY.PRG < prev    next >
Text File  |  1992-04-12  |  11KB  |  312 lines
  1. FUNCTION Mkey
  2. PARAMETER Vrnm, Vr, VrGt, Lnth
  3. *    Written by R.L. Coppedge
  4. *    Copyright 1992 dbF Software Productions
  5. *    By the way, dbF also has:
  6. *    SysTrak        A Computer Hardware/Software Inventory System
  7. *    Flags        A Flatfile Application Gen. for db3,4 and Fox
  8. *    ClasAdz        A Classified/Notice system for Networks
  9. *    FoxTails    A collection of FoxPro tools (like this one)
  10. *    Contact dbF for more information.
  11. *    dbF Software Productions
  12. *    P.O. Box 37194
  13. *    Cleve., Ohio 44137-0194
  14. *    CIS: 72117,165
  15. *    (216)491-4581
  16. *
  17. *    This code may be modified, but leave this original notice up
  18. *    here intact, if ya don't mind.  (Add your own comments about
  19. *    how much better you made it if you like)
  20. *    What this function does is allows a user to do a majority of
  21. *    data entry from the mouse, including character entry.  It 
  22. *    isn't a VALIDation, per se, but an entry piece.  See the sample
  23. *    code Foxtails.Prg for an example of how this would all work.
  24. *    The parameters are stated as such:
  25. *    Mkey((<expC1>, <expC2> , <expL1> [, <expN>])
  26. *    Where:
  27. *    expC1 is the name of the field
  28. *    expC2 is the initial starting value
  29. *    expL1 is it a GET? (a .F. means it's a STORE)
  30. *    expN1 is the maximum length (for Chr and numeric only)
  31. *
  32. ON KEY LABEL RIGHTMOUSE
  33. IF Vrgt                &&    If it's a GET, just read what it is...
  34.     Vrnm = VARREAD()
  35.     Vr =EVALUATE(Vrnm)
  36.     DO CASE
  37.     CASE TYPE(Vrnm) = "C"
  38.         Lnth = LEN(Vr)
  39.     CASE TYPE(Vrnm) = "L"
  40.         Lnth = 1
  41.     CASE TYPE(Vrnm) = "D"
  42.         Lnth = 8
  43.     CASE TYPE(Vrnm) = "N"        &&    Can't figure out a good way to do this
  44.         Lnth = 14            &&    14?  Yeah, that sound good
  45.     ENDCASE
  46. ENDIF
  47. CLEAR TYPEAHEAD
  48. *    Time to declare
  49. PRIVATE Tp, Msg, A1,A2,A3,A4,A5,A6,A7,A8,A9,A10
  50. PRIVATE Lim, Shft, Alt, Ctrl, Shftlck, Ret, Esc, X, Y
  51. DECLARE Ln(7,2), A(5)
  52. Tp = TYPE('Vr')        &&    What type of critter are we dealing with?
  53. IF Tp $ "CFN" AND TYPE('Lnth') = "N"        &&    Size limit on entered field
  54.     Lim = Lnth
  55. ELSE
  56.     Lim = 0
  57. ENDIF
  58. Tk = SET("Talk")
  59. SET TALK OFF
  60. DO CASE
  61.     CASE Tp = "C"
  62.     Msg = TRIM(Vr)
  63.     CASE Tp = "D"
  64.     Msg = DTOC(Vr)
  65.     CASE Tp $ "FN"
  66.     Msg = ALLTRIM(STR(Vr))
  67.     CASE Tp = "L"
  68.     Msg = IIF(Vr,"Y","N")
  69. ENDCASE        &&    Regardless of original type, we treat 'em all equal...
  70.             *    like they was true characters...
  71. DEFINE WINDOW Dsplay FROM 6,0 TO 8,79 TITLE "Entered Data"
  72. ACTIVATE WINDOW Dsplay        &&    This window shows what they've got so far
  73. @0,0 SAY Msg + ""
  74. DEFINE WINDOW Keyb FROM 9,0 TO 18,60 DOUBLE TITLE "Mouse_Key" FLOAT
  75. ACTIVATE WINDOW Keyb        &&    This is the pseudo-keyboard
  76. Ln(1,1) = "<E>  F1  F2  F3  F4  F5  F6  F7  F8  F9 F10 F11 F12"
  77. Ln(2,1) = "    `  1  2  3  4  5  6  7  8  9  0  -  =  \   "
  78. Ln(3,1) = "  <T>   q   w   e   r   t   y   u   i   o   p   [   ]"
  79. Ln(4,1) = "         a   s   d   f   g   h   j   k   l   ;   '   ┘"
  80. Ln(5,1) = "  <CL>    z   x   c   v   b   n   m   ,   .   /"
  81. Ln(6,1) = "  <S>   <C>   <A>   |---SPACE---|     \"
  82. *    Ln(#,1) shows what the Kb looks like when Shft is .F. (lowe-case)
  83. *    Ln(#,2) shows what the Kb looks like when Shft is .T. (upper-case)
  84.  
  85. Ln(1,2) = "<E> F1  F2  F3  F4  F5  F6  F7  F8  F9  F10 F11 F12"
  86. Ln(2,2) = "    ~  !  @  #  $  %  ^  &  *  (  )  _  +  |   "
  87. Ln(3,2) = "  <T>   Q   W   E   R   T   Y   U   I   O   P   {   }"
  88. Ln(4,2) = '         A   S   D   F   G   H   J   K   L   :   "   ┘'
  89. Ln(5,2) = "  <CL>    Z   X   C   V   B   N   M   <   >   ?"
  90. Ln(6,2) = "  <S>   <C>   <A>   |---SPACE---|     |"
  91. A(1) = "'1234567890-=\"
  92. A(2) = "qwertyuiop[]"
  93. A(3) = "asdfghjkl;'"
  94. A(4) = "zxcvbnm,./"
  95. A(5) = "~!@#$%^&*()_+|"
  96. *    A(#) is the array we use to determine the exact key "hit"
  97. STORE .F. TO Shft, Alt, Ctrl, Shftlck, Ret, Esc
  98. DO WHILE .T.    &&    our entry loop  (I know...we're not supposed
  99.                 *    to use DW.T.'s anymore...)
  100.     CLEAR        &&    Reset the Kb
  101.     FOR X = 1 TO 6
  102.         @X,0 SAY Ln(X,IIF(Shft,2,1))
  103.     ENDFOR
  104.     @7,0 SAY "<E>scape, <T>ab, <CL>Caps Lock, <S>hift, <C>ontrol, <A>lt"
  105.     @1,0 GET A1 PICTURE "@*IHT ;;;;;;;;;;;;" SIZE 1,3,1 DEFAULT 0 VALID KVal(A1,"1")
  106.     @2,4 GET A2 PICTURE "@*IHT ;;;;;;;;;;;;;;" SIZE 1,2,1 DEFAULT 0 VALID KVal(A2,"2")
  107.     @3,2 GET A3 PICTURE "@*IHT" SIZE 1,3,1 DEFAULT 0 VALID KVal(A3,"3")
  108.     @3,7 GET A4 PICTURE "@*IHT ;;;;;;;;;;;" SIZE 1,3,1 DEFAULT 0 VALID KVal(A4,"4")
  109.     @4,8 GET A5 PICTURE "@*IHT ;;;;;;;;;;;" SIZE 1,3,1 DEFAULT 0 VALID KVal(A5,"5")
  110.     @5,2 GET A6 PICTURE "@*IHT" SIZE 1,4,1 DEFAULT 0 VALID KVal(A6,"6")
  111.     @5,9 GET A7 PICTURE "@*IHT ;;;;;;;;;" SIZE 1,3,1 DEFAULT 0 VALID KVal(A7,"7")
  112.     @6,2 GET A8 PICTURE "@*IHT ;;" SIZE 1,3,3 DEFAULT 0 VALID KVal(A8,"8")
  113.     @6,20 GET A9 PICTURE "@*IHT" SIZE 1,13,1 DEFAULT 0 VALID KVal(A9,"9")
  114.     @6,37 GET A10 PICTURE "@*IHT" SIZE 1,3,1 DEFAULT 0 VALID KVal(A10,"10")
  115. *    It's all done with mirrors....er, invisible boxes...
  116.     READ CYCLE 
  117.     IF LASTKEY() = 27 OR Ret OR Esc
  118.         EXIT    &&    They hit escape (real {27}, imagined {esc}) or Return
  119.     ENDIF
  120. ENDDO
  121. RELEASE WINDOW Dsplay, Keyb
  122. IF LASTKEY() = 27 OR Esc        &&    Escape, return original value
  123.     IF Tk = "ON"
  124.         SET TALK ON
  125.     ENDIF
  126.     IF Vrgt            &&    Was it a GET or a STORE
  127.         SHOW GETS
  128.         ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0
  129.         RETURN        &&    A Get lies here!
  130.     ELSE
  131.         ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0
  132.         RETURN Vr    &&    A Store
  133.     ENDIF
  134. ENDIF
  135. *    Otherwise, we need to pass the new value...
  136. *    1st we need to convert the data type back to what it was originally
  137. DO CASE
  138.     CASE Tp = "C"
  139.     Passit = Msg
  140.     CASE Tp = "D"
  141.     Passit = CTOD(Msg)
  142.     CASE Tp $ "FN"
  143.     Passit = VAL(Msg)
  144.     CASE Tp = "L"
  145.     Passit = Msg$"YyTt1"
  146. ENDCASE
  147. IF Tk = "ON"
  148.     SET TALK ON
  149. ENDIF
  150. IF Vrgt            &&    If it's a GET
  151.     &Vrnm. = Passit
  152.     SHOW GETS
  153.     ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0
  154.     RETURN
  155. ENDIF
  156. ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0
  157. RETURN Passit
  158. *    End of main procedure Code for Mkey
  159.  
  160. FUNCTION KVal
  161. PARAMETERS X, Y
  162. *    Y is the the row that they hit, X is the column
  163. *    What the heck did they really select?  I dunno, let's find out!
  164.  
  165. PRIVATE Mm, Dd, Yy, Fd, Gd, Adltr
  166. Adltr = ""        &&    This is the variable that holds the value selected
  167. DO CASE
  168.     CASE Y == "1"
  169.     Esc = (X=1)        &&    If it's 1, they hit Escape
  170.     *    Here's where you could get cute, and add additional code for
  171.     *    what would come out for each of the Function keys or their
  172.     *    Combinations...
  173.  
  174.     CASE Y == "2"
  175.     IF X <> 15
  176.         Adltr = IIF(Shft,SUBSTR(A(5),X,1),SUBSTR(A(1),X,1))
  177.     ELSE        &&    Backspace, delete rightmost character
  178.         IF LEN(Msg) > 0        &&    if it exists, that is...
  179.             Msg = LEFT(Msg,LEN(Msg)-1)
  180.         ENDIF
  181.     ENDIF
  182.  
  183.     CASE Y == "3"        &&    Tab...just a tab
  184.     Adltr = chr(0)    &&    What the #%^#$^ is a tab Char?
  185.  
  186.     CASE Y == "4"
  187.     IF X <= 10
  188.         *    Check to see which key they hit.  If it's <= 10, either
  189.         *    upper or lower case "qwertyuiop" depending on Shft
  190.         Adltr = IIF(Shft,UPPER(SUBSTR(A(2),X,1)),SUBSTR(A(2),X,1))
  191.     ELSE
  192.         *    Otherwise, it's either [] or {}, again depending on the key
  193.         *    hit (X) and the shift status (Shft)
  194.         Adltr = IIF(X=11 AND Shft,"{",IIF(X=11 AND !Shft,"[",IIF(X=12 AND Shft,"}","]")))
  195.     ENDIF
  196.  
  197.     CASE Y == "5"
  198.     DO CASE
  199.         CASE X <= 9
  200.             *    In this case, check to see X <= 9, which'll cause either
  201.             *    upper or lower case "asdfghjkl" depending on Shft
  202.             Adltr = IIF(Shft,UPPER(SUBSTR(A(3),X,1)),SUBSTR(A(3),X,1))
  203.         CASE X = 12            &&    They've hit "Enter"...they're done...maybe
  204.         Fd = .T.
  205.         IF Tp = "D"        &&    If it's a date, did they do good?
  206.             Gd = .T.
  207.             IF AT("/",Msg,1) <> 1 AND AT("/",Msg,2) <> LEN(Msg) AND ;
  208.                 AT("/",Msg,2) <> 0 AND BETWEEN(AT("/",Msg,2) - AT("/",Msg,1),2,3)
  209.                 *    check for # of /'s, spacing, etc.
  210.                 mm = VAL(LEFT(Msg,AT("/",Msg,1)))
  211.                 dd = VAL(SUBSTR(Msg,AT("/",Msg,1)+1,AT("/",Msg,2)-1))
  212.                 yy = VAL(RIGHT(Msg,LEN(Msg)-AT("/",Msg,2)))
  213.                 IF BETWEEN(Mm,1,12)        &&    Good month?
  214.                     Dys = IIF(INLIST(Mm,4,6,9,11),30,31)
  215.                     IF Mm = 2            &&    Oh, yeah...February
  216.                         Dys = IIF(Yy/4=INT(Yy/4) AND Yy/1000 <> INT(Yy/1000) ,29,28)
  217.                     ENDIF
  218.                     Gd = BETWEEN(Dd,1,Dys)        &&    Good days?
  219.                 ENDIF
  220.             ELSE
  221.                 Gd = .F.
  222.             ENDIF
  223.             IF !Gd
  224.                 WAIT "Uh...valid dates are mm/dd/yy" WINDOW
  225.                 Fd = .F.
  226.             ENDIF
  227.         ENDIF
  228.         Ret = Fd
  229.         OTHERWISE
  230.         Adltr = IIF(X=10 AND Shft,":",IIF(X=10 AND !Shft,";",IIF(X=11 AND Shft,'"',"'")))
  231.         *    must be :;'"...onea them guys
  232.     ENDCASE
  233.  
  234.     CASE Y == "6"        &&    Shift lock toggle
  235.     IF Shftlck
  236.         Shft = .F.
  237.         Shftlck = .F.
  238.     ELSE
  239.         Shft = .T.
  240.         Shftlck = .T.
  241.     ENDIF
  242.  
  243.     CASE Y == "7"
  244.     IF X <= 7
  245.         Adltr = IIF(Shft,UPPER(SUBSTR(A(4),X,1)),SUBSTR(A(4),X,1))
  246.         *    In this case, check to see X <= 7, which'll cause either
  247.         *    upper or lower case "zxcvbnm" depending on Shft
  248.     ELSE
  249.         Adltr = IIF(X=8 AND Shft,"<",IIF(X=8 AND !Shft,",",IIF(X=9 ;
  250.         AND Shft,">",IIF(X=9 AND !Shft,".",IIF(X=10 AND Shft,"?","/")))))
  251.         *    8, 9, 10 could be ,< .> /?
  252.     ENDIF
  253.  
  254.     CASE Y == "8"        &&    Either Shift, Control, or Alt.
  255.     Shft = (X=1)        &&    Shift only works for the next key.
  256.     Ctrl = (X=2)        &&    Control and Alt don't do anything,
  257.     Alt = (X=3)            &&    actually...but that could change
  258.                         *    in future releases
  259.  
  260.     CASE Y == "9"        &&    Space...the final...never mind...
  261.     Adltr = " "
  262.  
  263.     CASE Y == "10"        &&    On my keyboard this little suckers stuck
  264.     Adltr = IIF(Shft,"|","\")    &&    on the lower right...
  265.  
  266. ENDCASE
  267. IF Y <> "8"            &&    Check the status keys...
  268.     Shft = Shftlck
  269.     Ctrl = .F.
  270.     Alt = .F.
  271. ENDIF
  272. *    Now, depending on the type of variable, we'll add it to the
  273. *    Msg field...wow!
  274. IF !EMPTY(Adltr) OR Adltr = " "        &&    Since Fox thinks " " is empty
  275.     DO CASE
  276.         CASE Lim > 0 AND LEN(Msg) >= Lim    &&    Check length if necessary
  277.             WAIT "Entry Is Limited to " + ALLTRIM(STR(Lim)) + " Chars...Too long!" WINDOW
  278.         CASE Tp = "C"        &&    if it's a character, just add field
  279.          Msg = Msg + Adltr
  280.         CASE Tp = "L" AND !Adltr $ "YyTt1NnFf0"    &&    How do you say Yup?
  281.         WAIT "Logicals need to be YyTt1 (for True) or NnFf0 (No)!" WINDOW
  282.         CASE Tp = "L" AND LEN(Msg) = 1    &&    And how long?
  283.         WAIT "Logicals are only 1 character long (YyTt1NnFf0)" WINDOW
  284.         CASE Tp = "L"        &&    If it got this far it's ok by me!
  285.         Msg = Adltr
  286.         CASE Tp $ "FN" AND !Adltr $ "1234567890."    &&    #'s for #'s
  287.         WAIT "Numbers need to be, well...y'know, numbers..." WINDOW
  288.         CASE Tp $ "FN" AND Adltr = "."
  289.         IF AT(".",Msg) <> 0        &&    if there's already a decimal point
  290.             Msg = STUFF(Msg,AT(".",Msg),1,"")+"."    &&    we need to move it!
  291.         ELSE
  292.             Msg = Msg + "."
  293.         ENDIF
  294.         CASE Tp $ "FN"
  295.         Msg = Msg + Adltr
  296.         CASE Tp = "D" AND !Adltr $ "1234567890/"    &&    Bad stuff for dates!
  297.         WAIT "Dates are in the form of mm/dd/yy..." WINDOW
  298.         CASE Tp = "D"    &&    Must be good for dates!
  299.     *    Here I don't bother checking for valid dates...I do that
  300.     *    at the end.
  301.         Msg = Msg + Adltr
  302.     ENDCASE
  303. ENDIF
  304.  
  305. ACTIVATE WINDOW Dsplay
  306. *    Show the world the wonderful things we just did...and gloat
  307. *    just a tad.
  308. CLEAR
  309. @0,0 SAY Msg + ""
  310. ACTIVATE WINDOW Dsplay
  311. RETURN .T.
  312.