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
Wrap
Text File
|
1992-11-08
|
5KB
|
207 lines
/***
* Checks.prg
*
* Simple program to illustrate use of Check boxes
*/
#include "Getexit.ch"
#include "InKey.ch"
#define K_SPACE 32
#define CHECK_BOX "X"
#command @ <row>, <col> GET <var> CHECKBOX <cStr> ;
;
=> ;
SetPos(<row>, <col>) ;
; CheckGet({|x| iif(x == NIL, <var>, <var> := x) }, ;
<(var)>, <cStr>, GetList) ;
; DrawCheck(Atail(GetList))
MEMVAR GetList
FUNCTION CheckTest
LOCAL lBackSideX := .T.
LOCAL lBackSideY := .F.
LOCAL lUnitLineX := .T.
LOCAL lUnitLineY := .F.
LOCAL lUnitLineZ := .F.
LOCAL lScalingX := .T.
LOCAL lScalingY := .T.
LOCAL lScalingZ := .F.
CLEAR SCREEN
@ 6, 10 GET lBackSideX CHECKBOX "Back Side X"
@ 7, 10 GET lBackSideY CHECKBOX "Back Side Z"
@ 9, 10 GET lUnitLineX CHECKBOX "Unit Line X"
@ 10, 10 GET lUnitLineY CHECKBOX "Unit Line Y"
@ 11, 10 GET lUnitLineZ CHECKBOX "Unit Line Z"
@ 13, 10 GET lScalingX CHECKBOX "Scaling X"
@ 14, 10 GET lScalingY CHECKBOX "Scaling Y"
@ 14, 10 GET lScalingZ CHECKBOX "Scaling Z"
READ
RETURN NIL
FUNCTION CheckGet(bVar, cVar, cStr, aGetList)
LOCAL oGet
LOCAL nRow := Row(), nCol := Col()
LOCAL nSaveRow, nSaveCol
// Display [ ] before the get
DevPos(nRow, nCol)
DevOut("[ ]")
// Create an empty get object and add it to the list
oGet := GetNew()
Aadd(aGetList, oGet)
// Its position is 4 spaces to the right of the cursor
// (just past [ ] )
oGet:col := nCol + 4
oGet:row := nRow
// Set get:name for hot keys
oGet:name := cVar
// Get / Set block for real variable
oGet:cargo := bVar
// The get's get / set block simply returns the text string
// corresponding to the get
oGet:block := {|| cStr }
// Check box gets have their own reader, of course
oGet:reader := {|o| CheckReader(o, aGetList) }
oGet:display()
RETURN oGet
// The reader for check boxces
Proc CheckReader( oGet, aGetList )
// read the GET if the WHEN condition is satisfied
IF ( GetPreValidate(oGet) )
// activate the GET for reading
oGet:SetFocus()
DO WHILE ( oGet:exitState == GE_NOEXIT )
// check for initial typeout (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// apply keystrokes until exit
DO WHILE ( oGet:exitState == GE_NOEXIT )
CheckApplyKey(oGet, InKey(0), aGetList)
ENDDO
// disallow exit if the VALID condition is not satisfied
IF ( !GetPostValidate(oGet) )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
// de-activate the GET
oGet:KillFocus()
ENDIF
RETURN
PROC CheckApplyKey(oGet, nKey, aGetList)
LOCAL cKey
LOCAL bKeyBlock
LOCAL nSaveRow, nSaveCol
// check for SET KEY first
IF ( (bKeyBlock := SetKey(nKey)) <> NIL )
GetDoSetKey(bKeyBlock, oGet)
RETURN // NOTE
ENDIF
DO CASE
CASE ( nKey == K_UP )
oGet:exitState := GE_UP
CASE ( nKey == K_SH_TAB )
oGet:exitState := GE_UP
CASE ( nKey == K_DOWN )
oGet:exitState := GE_DOWN
CASE ( nKey == K_TAB )
oGet:exitState := GE_DOWN
CASE ( nKey == K_ENTER )
oGet:exitState := GE_ENTER
CASE nKey == K_SPACE
// Toggle state of this check box.
Eval(oGet:cargo, !Eval(oGet:cargo))
// And redraw the getlist
DrawCheck(oGet)
CASE ( nKey == K_ESC )
IF ( Set(_SET_ESCAPE) )
oGet:undo()
oGet:exitState := GE_ESCAPE
ENDIF
CASE (nKey == K_PGUP )
oGet:exitState := GE_WRITE
CASE (nKey == K_PGDN )
oGet:exitState := GE_WRITE
CASE ( nKey == K_CTRL_HOME )
oGet:exitState := GE_TOP
// both ^W and ^End terminate the READ (the default)
CASE (nKey == K_CTRL_W)
oGet:exitState := GE_WRITE
CASE (nKey == K_INS)
Set( _SET_INSERT, !Set(_SET_INSERT) )
ENDCASE
RETURN
// Redraw check box
PROC DrawCheck(oGet)
LOCAL lSelected := Eval(oGet:cargo)
LOCAL oGet1
LOCAL nSaveRow := Row()
LOCAL nSaveCol := Col()
LOCAL nGet
DevPos(oGet:row, oGet:col - 3)
IF lSelected
DevOut(CHECK_BOX)
ELSE
DevOut(" ")
ENDIF
DevPos(nSaveRow, nSaveCol)
RETURN