home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / s / s9302.zip / SPENCE.ZIP / CHECKS.PRG
Text File  |  1992-11-08  |  5KB  |  207 lines
  1. /***
  2. * Checks.prg
  3. *
  4. * Simple program to illustrate use of Check boxes
  5. */
  6.  
  7. #include "Getexit.ch"
  8. #include "InKey.ch"
  9.  
  10. #define K_SPACE 32
  11. #define CHECK_BOX "X"
  12.  
  13. #command @ <row>, <col> GET <var> CHECKBOX <cStr>                ;
  14.                                                                  ;
  15.       =>                                                         ;
  16.          SetPos(<row>, <col>)                                    ;
  17.          ; CheckGet({|x| iif(x == NIL, <var>, <var> := x) },     ;
  18.                      <(var)>, <cStr>, GetList)                   ;
  19.          ; DrawCheck(Atail(GetList))
  20.  
  21. MEMVAR GetList
  22.  
  23.  
  24. FUNCTION CheckTest
  25.  
  26. LOCAL lBackSideX := .T.
  27. LOCAL lBackSideY := .F.
  28.  
  29. LOCAL lUnitLineX := .T.
  30. LOCAL lUnitLineY := .F.
  31. LOCAL lUnitLineZ := .F.
  32.  
  33. LOCAL lScalingX  := .T.
  34. LOCAL lScalingY  := .T.
  35. LOCAL lScalingZ  := .F.
  36.  
  37.  
  38.   CLEAR SCREEN
  39.  
  40.   @ 6,  10 GET lBackSideX CHECKBOX "Back Side X"
  41.   @ 7,  10 GET lBackSideY CHECKBOX "Back Side Z"
  42.  
  43.   @ 9,  10 GET lUnitLineX CHECKBOX "Unit Line X"
  44.   @ 10, 10 GET lUnitLineY CHECKBOX "Unit Line Y"
  45.   @ 11, 10 GET lUnitLineZ CHECKBOX "Unit Line Z"
  46.  
  47.   @ 13, 10 GET lScalingX  CHECKBOX "Scaling X"
  48.   @ 14, 10 GET lScalingY  CHECKBOX "Scaling Y"
  49.   @ 14, 10 GET lScalingZ  CHECKBOX "Scaling Z"
  50.  
  51.   READ
  52.  
  53. RETURN NIL
  54.  
  55.  
  56. FUNCTION CheckGet(bVar, cVar, cStr, aGetList)
  57.  
  58. LOCAL oGet
  59. LOCAL nRow := Row(), nCol := Col()
  60. LOCAL nSaveRow, nSaveCol
  61.  
  62.   // Display [ ] before the get
  63.   DevPos(nRow, nCol)
  64.   DevOut("[ ]")
  65.  
  66.   // Create an empty get object and add it to the list
  67.   oGet := GetNew()
  68.   Aadd(aGetList, oGet)
  69.  
  70.   // Its position is 4 spaces to the right of the cursor
  71.   // (just past [ ] )
  72.   oGet:col   := nCol + 4
  73.  
  74.   oGet:row   := nRow
  75.  
  76.   // Set get:name for hot keys
  77.   oGet:name  := cVar
  78.  
  79.   // Get / Set block for real variable
  80.   oGet:cargo := bVar
  81.  
  82.   // The get's get / set block simply returns the text string
  83.   // corresponding to the get
  84.   oGet:block := {|| cStr }
  85.  
  86.   // Check box gets have their own reader, of course
  87.   oGet:reader := {|o| CheckReader(o, aGetList) }
  88.  
  89.   oGet:display()
  90.  
  91. RETURN oGet
  92.  
  93.  
  94. // The reader for check boxces
  95. Proc CheckReader( oGet, aGetList )
  96.  
  97.   // read the GET if the WHEN condition is satisfied
  98.   IF ( GetPreValidate(oGet) )
  99.     // activate the GET for reading
  100.     oGet:SetFocus()
  101.  
  102.     DO WHILE ( oGet:exitState == GE_NOEXIT )
  103.       // check for initial typeout (no editable positions)
  104.       IF ( oGet:typeOut )
  105.         oGet:exitState := GE_ENTER
  106.       ENDIF
  107.  
  108.       // apply keystrokes until exit
  109.       DO WHILE ( oGet:exitState == GE_NOEXIT )
  110.         CheckApplyKey(oGet, InKey(0), aGetList)
  111.       ENDDO
  112.  
  113.       // disallow exit if the VALID condition is not satisfied
  114.       IF ( !GetPostValidate(oGet) )
  115.         oGet:exitState := GE_NOEXIT
  116.       ENDIF
  117.     ENDDO
  118.  
  119.     // de-activate the GET
  120.     oGet:KillFocus()
  121.   ENDIF
  122.  
  123. RETURN
  124.  
  125.  
  126. PROC CheckApplyKey(oGet, nKey, aGetList)
  127.  
  128. LOCAL cKey
  129. LOCAL bKeyBlock
  130. LOCAL nSaveRow, nSaveCol
  131.  
  132.   // check for SET KEY first
  133.   IF ( (bKeyBlock := SetKey(nKey)) <> NIL )
  134.     GetDoSetKey(bKeyBlock, oGet)
  135.     RETURN  // NOTE
  136.   ENDIF
  137.  
  138.   DO CASE
  139.     CASE ( nKey == K_UP )
  140.       oGet:exitState := GE_UP
  141.  
  142.     CASE ( nKey == K_SH_TAB )
  143.       oGet:exitState := GE_UP
  144.  
  145.     CASE ( nKey == K_DOWN )
  146.       oGet:exitState := GE_DOWN
  147.  
  148.     CASE ( nKey == K_TAB )
  149.       oGet:exitState := GE_DOWN
  150.  
  151.     CASE ( nKey == K_ENTER )
  152.       oGet:exitState := GE_ENTER
  153.  
  154.     CASE nKey == K_SPACE
  155.       // Toggle state of this check box.
  156.       Eval(oGet:cargo, !Eval(oGet:cargo))
  157.  
  158.       // And redraw the getlist
  159.       DrawCheck(oGet)
  160.  
  161.     CASE ( nKey == K_ESC )
  162.       IF ( Set(_SET_ESCAPE) )
  163.         oGet:undo()
  164.         oGet:exitState := GE_ESCAPE
  165.       ENDIF
  166.  
  167.     CASE (nKey == K_PGUP )
  168.       oGet:exitState := GE_WRITE
  169.  
  170.     CASE (nKey == K_PGDN )
  171.       oGet:exitState := GE_WRITE
  172.  
  173.     CASE ( nKey == K_CTRL_HOME )
  174.       oGet:exitState := GE_TOP
  175.  
  176.     // both ^W and ^End terminate the READ (the default)
  177.     CASE (nKey == K_CTRL_W)
  178.       oGet:exitState := GE_WRITE
  179.  
  180.     CASE (nKey == K_INS)
  181.       Set( _SET_INSERT, !Set(_SET_INSERT) )
  182.  
  183.   ENDCASE
  184.  
  185. RETURN
  186.  
  187.  
  188. // Redraw check box
  189. PROC DrawCheck(oGet)
  190.  
  191. LOCAL lSelected := Eval(oGet:cargo)
  192. LOCAL oGet1
  193. LOCAL nSaveRow := Row()
  194. LOCAL nSaveCol := Col()
  195. LOCAL nGet
  196.  
  197.   DevPos(oGet:row, oGet:col - 3)
  198.   IF lSelected
  199.     DevOut(CHECK_BOX)
  200.   ELSE
  201.     DevOut(" ")
  202.   ENDIF
  203.  
  204.   DevPos(nSaveRow, nSaveCol)
  205.  
  206. RETURN
  207.