home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST178.PRG < prev    next >
Encoding:
Text File  |  1989-11-01  |  3.8 KB  |  129 lines
  1. ********************
  2.  
  3. FUNCTION Inlist
  4.  
  5.    *
  6.    * The INLIST() function validates that the parameter passed 
  7.    * in found in the of elements in the string of options.
  8.    *
  9.    * This function was written by Joseph D. Booth and contributed
  10.    * to the Steve Straley ToolkiT.
  11.    *
  12.    * Modified to accept an array element by reference.
  13.    *
  14.  
  15.    PARAMETER _testcode, _thelist, _thereq, _thecolor
  16.  
  17.    PRIVATE _retval, _piece, _wrow, _wcol, _wcolor, _anarray
  18.    PRIVATE _helplist[ OCCURENCE("/",_thelist)+1 ], _ctr, _pick
  19.  
  20.    IF LASTKEY() = 5
  21.       RETURN(.T.)
  22.    ENDIF
  23.  
  24.    IF PCOUNT() = 2
  25.       _thereq   = .T.
  26.       _thecolor = SETCOLOR()
  27.    ELSEIF PCOUNT() = 3
  28.       _thecolor = SETCOLOR()
  29.    ENDIF
  30.    IF ( EMPTY(_testcode) .AND. !_thereq )  && If up arrow was pressed, do not
  31.       RETURN(.T.)                          && validate the field                               
  32.    ENDIF
  33.  
  34.    IF TYPE("_testcode") = "L"
  35.       _anarray = .F.
  36.    ELSE
  37.       _anarray = ("["$_testcode)   && This tests to see if the element passed to the
  38.                                    && function was a memeber of an array.  If so, then
  39.                                    && the function will macro the string which creates
  40.                                    && the effect of passing the parameter by reference.
  41.                                    && Otherwise, the "@" sign will be used and the
  42.                                    && parameter will ideed be passed by reference
  43.    ENDIF
  44.    
  45.    _retval = .F.
  46.    _ctr    = 0
  47.    _wrow   = ROW()
  48.    _wcol   = COL()
  49.    _wcolor = Set_color(Attribute(_wrow, _wcol) )
  50.  
  51.    SETCOLOR(IF( (ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), _thecolor, SETCOLOR()))
  52.  
  53.    DO WHILE ! EMPTY(_thelist)
  54.       SETCOLOR(_wcolor)
  55.       _piece = PARSING(@_thelist)
  56.       _ctr = _ctr +1
  57.       _helplist[_ctr] = _piece
  58.       IF !_anarray
  59.          IF TYPE("_testcode") != "L"
  60.             IF _testcode = LEFT( _piece,1) .AND. ! EMPTY( _piece )
  61.                @ _wrow,_wcol+1 SAY _piece
  62.                _retval = .T.
  63.                EXIT
  64.             ENDIF
  65.          ELSE
  66.             _retval = .F.
  67.          ENDIF
  68.       ELSE
  69.          IF TYPE(_testcode) != "L"
  70.             IF &_testcode. = LEFT(_piece,1) .AND. ! EMPTY( _piece )
  71.                @ _wrow,_wcol+1 SAY _piece
  72.                _retval = .T.
  73.                EXIT
  74.             ELSE
  75.                _retval = .F.
  76.             ENDIF
  77.          ENDIF
  78.       ENDIF
  79.  
  80.    ENDDO
  81.  
  82.    SETCOLOR(_thecolor)
  83.  
  84.    _a1row = ROW()
  85.    _a1col = COL() + 2
  86.    
  87.    IF _a1col + IF((Length_el(_helplist) < 15), 15, Length_el(_helplist)) > 80
  88.       _a1col = 78 - IF((Length_el(_helplist) < 15), 15, Length_el(_helplist))
  89.       _a1row = _a1row + 1
  90.    ENDIF
  91.  
  92.    IF _a1row + LEN(_helplist) + 5 > 24
  93.       _a1row = 24 - LEN(_helplist) - 7
  94.    ENDIF
  95.  
  96.    IF ! _retval
  97.       _pick = Apop( _a1row, _a1col, _ctr+4,LENGTH_EL(_helplist)+8,_helplist )
  98.       SETCOLOR(_wcolor)
  99.       IF _pick > 0
  100.          _retval = .T.
  101.          IF !_anarray
  102.             IF TYPE("_testcode") != "L"
  103.                _testcode = LEFT( _helplist[_pick],1 )
  104.                _joecolor = SETCOLOR()
  105.                SETCOLOR(Set_color(Attribute(_wrow,_wcol-1)))
  106.                @ _wrow,_wcol-1 SAY _testcode
  107.                SETCOLOR(_joecolor)
  108.                @ _wrow, _wcol+1 SAY _helplist[_pick]
  109.             ENDIF
  110.          ELSE
  111.             IF TYPE(_testcode) != "L"
  112.                &_testcode. = LEFT( _helplist[_pick],1 )
  113.                _joecolor = SETCOLOR()
  114.                SETCOLOR(Set_color(Attribute(_wrow,_wcol-1)))
  115.                @ _wrow,_wcol-1 SAY &_testcode.
  116.                SETCOLOR(_joecolor)
  117.                @ _wrow, _wcol+1 SAY _helplist[_pick]
  118.             ENDIF
  119.          ENDIF
  120.       ENDIF
  121.    ENDIF
  122.    SETCOLOR(_thecolor)
  123.    RETURN(_retval)
  124.  
  125. * End of File
  126.  
  127.  
  128.  
  129.