home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETPRGS.EXE / GETS15.PRG < prev    next >
Encoding:
Text File  |  1992-03-08  |  4.7 KB  |  188 lines
  1. /***
  2. * Gets15.prg
  3. *
  4. * The minstrel in the gallery,
  5. * Looked down upon the smiling faces
  6. *
  7. * Calculator style input
  8. */
  9.  
  10.  
  11. #include "Getexit.ch"
  12. #include "Inkey.ch"
  13.  
  14. #command @ <row>, <col> GET <var>                                      ;
  15.                         [<clauses,...>]                                ;
  16.                         CALCULATOR                                     ;
  17.                         [<moreClauses,...>]                            ;
  18.                                                                        ;
  19.       => @ <row>, <col> GET <var>                                      ;
  20.                         [<clauses>]                                    ;
  21.                         SEND reader := {|oGet|                         ;
  22.                                         GetCalc(oGet) }                ;
  23.                         [<moreClauses>]
  24.  
  25. MEMVAR GetList
  26.  
  27. FUNCTION Gets15
  28.  
  29. LOCAL nVar1 := 0, ;
  30.       nVar2 := 0, ;
  31.       cVar2 := Space(12), ;
  32.       nVar3 := 0
  33.  
  34.  
  35.   CLEAR SCREEN
  36.   @ 10, 10 SAY "Enter nVar1" GET nVar1 CALC PICT "@R 9,999,999,999"
  37.   @ 11, 10 SAY "Enter nVar2" GET nVar2 CALC PICT "@R 99,999,999.99"
  38.   @ 12, 10 SAY "Enter cVar2" GET cVar2 CALC
  39.   @ 13, 10 SAY "Enter nVar3" GET nVar3
  40.  
  41.   READ
  42.  
  43. RETURN NIL
  44.  
  45.  
  46. proc GetCalc( oGet )
  47.  
  48.  
  49.   // read the GET if the WHEN condition is satisfied
  50.   IF ( GetPreValidate(oGet) )
  51.     // activate the GET for reading
  52.     oGet:SetFocus()
  53.  
  54.     // RS added this 
  55.     // Start at last position
  56.     oGet:end()
  57.     // Just to here
  58.  
  59.     DO WHILE ( oGet:exitState == GE_NOEXIT )
  60.       // check for initial typeout (no editable positions)
  61.       IF ( oGet:typeOut )
  62.         oGet:exitState := GE_ENTER
  63.       ENDIF
  64.  
  65.       // apply keystrokes until exit
  66.       DO WHILE ( oGet:exitState == GE_NOEXIT )
  67.         GetCalcApplyKey(oGet, InKey(0))
  68.       ENDDO
  69.  
  70.       // disallow exit if the VALID condition is not satisfied
  71.       IF ( !GetPostValidate(oGet) )
  72.         oGet:exitState := GE_NOEXIT
  73.       ENDIF
  74.     ENDDO
  75.     // de-activate the GET
  76.     oGet:KillFocus()
  77.   ENDIF
  78.  
  79. RETURN
  80.  
  81.  
  82. /***
  83. * GetCalcApplyKey()
  84. * Apply a single Inkey() keystroke to a GET.
  85. *
  86. * NOTE: GET must have focus.
  87. * Standard stuff. RS changed only BS and otherwise
  88. */
  89.  
  90. #define K_UNDO          K_CTRL_U
  91.  
  92. proc GetCalcApplyKey(oGet, nKey)
  93.  
  94. local cKey
  95. local bKeyBlock
  96. local cTemp
  97. local nTemp
  98.  
  99.   // check for SET KEY first
  100.   IF (bKeyBlock := SetKey(nKey)) <> NIL
  101.     GetDoSetKey(bKeyBlock, oGet)
  102.     RETURN                              // NOTE
  103.   ENDIF
  104.  
  105.   DO CASE
  106.     CASE nKey == K_UP
  107.       oGet:exitState := GE_UP
  108.  
  109.     CASE nKey == K_SH_TAB
  110.       oGet:exitState := GE_UP
  111.  
  112.     CASE nKey == K_DOWN
  113.       oGet:exitState := GE_DOWN
  114.  
  115.     CASE nKey == K_TAB
  116.       oGet:exitState := GE_DOWN
  117.  
  118.     CASE nKey == K_ENTER
  119.       oGet:exitState := GE_ENTER
  120.  
  121.     CASE nKey == K_ESC
  122.       IF Set(_SET_ESCAPE)
  123.         oGet:undo()
  124.         oGet:exitState := GE_ESCAPE
  125.       ENDIF
  126.  
  127.     CASE nKey == K_PGUP
  128.       oGet:exitState := GE_WRITE
  129.  
  130.     CASE nKey == K_PGDN
  131.       oGet:exitState := GE_WRITE
  132.  
  133.     CASE nKey == K_CTRL_HOME
  134.       oGet:exitState := GE_TOP
  135.  
  136.     // both ^W and ^End terminate the READ (the default)
  137.     CASE nKey == K_CTRL_W
  138.       oGet:exitState := GE_WRITE
  139.  
  140.     CASE nKey == K_UNDO
  141.       oGet:Undo()
  142.  
  143.     CASE nKey == K_BS .OR. nKey == K_DEL
  144.       oGet:delete()
  145.       IF oGet:type == "C"
  146.         cTemp := oGet:unTransform()
  147.         cTemp := " " + Substr(cTemp, 1, Len(cTemp) - 1)
  148.         oGet:buffer := Transform(cTemp, oGet:picture)
  149.       ELSE
  150.         nTemp := oGet:unTransform()
  151.         IF At(".", oGet:buffer) != 0
  152.           // There is a decimal point
  153.           nTemp := nTemp / 10
  154.         ELSE
  155.           // No decimal point, division already taken place
  156.           // by deleting last character
  157.         ENDIF
  158.         oGet:buffer := Transform(nTemp, oGet:picture)
  159.       ENDIF
  160.       oGet:display()
  161.  
  162.     OTHERWISE
  163.       IF (nKey >= Asc('0') .AND. nKey <= Asc('9')) .OR. ;
  164.           (nKey == Asc('.') .AND. ;
  165.            oGet:type == "C" .AND. At(".", oGet:buffer) == 0)
  166.  
  167.         cKey := Chr(nKey)
  168.         IF oGet:type == "C"
  169.           cTemp := oGet:unTransform()
  170.           cTemp := SubStr(cTemp, 2) + " "
  171.           oGet:buffer := Transform(cTemp, oGet:picture)
  172.         ELSE
  173.           nTemp := oGet:unTransform()
  174.           nTemp := nTemp * 10
  175.           oGet:buffer := Transform(nTemp, oGet:picture)
  176.         ENDIF
  177.         // NOTE - important to use OverStrike here to set changed
  178.         // Alternative is to stuff key yourself. However, that does
  179.         // not set changed, therefore var is not updated.
  180.         oGet:overStrike(cKey)
  181.         oGet:end()
  182.         oGet:display()
  183.     ENDIF
  184.   ENDCASE
  185.  
  186. RETURN
  187.  
  188.