home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST208.PRG < prev    next >
Encoding:
Text File  |  1989-09-25  |  3.0 KB  |  128 lines
  1. ********************
  2.  
  3. FUNCTION Intable
  4.  
  5.    * The infile() function validates that the parameter passed in 
  6.    * found in the file indicated
  7.    *
  8.    * Add color parameters...
  9.  
  10.    PARAMETER _tcode, _tarea, _tkey, _mfield, _sfields, ;
  11.              _farray, _atsayr, _atsayc, _req
  12.  
  13.    PRIVATE _retrnval, _newarea, _wrow, _wcol, _return, ;
  14.            _tme, _ok, _pick, _wwhere, _wdown, _wover, _wover, _hold
  15.  
  16.    IF LASTKEY() = 5         && If up arrow was pressed, do not validate
  17.       RETURN(.T.)           && the field
  18.    ENDIF
  19.  
  20.    IF PCOUNT() = 5
  21.       _farray = ""
  22.       _atsayr = ROW()
  23.       _atsayc = COL()
  24.       _req = .F.
  25.    ELSEIF PCOUNT() = 6
  26.       _atsayr = ROW()
  27.       _atsayc = COL()
  28.       _req = .F.
  29.    ELSEIF PCOUNT() = 7
  30.       _atsayc = COL()
  31.       _req = .F.
  32.    ELSEIF PCOUNT() = 8
  33.       _req = .F.
  34.    ENDIF
  35.  
  36.    scrpath = IF((TYPE("scrpath") = "U"), "", scrpath)
  37.    scrdata = IF((TYPE("scrdata") = "U"), "", scrdata)
  38.  
  39.    _wrow = ROW() + 1
  40.    _wcol = COL()
  41.    _newarea = 0
  42.    _return  = SELECT()
  43.  
  44.    IF EMPTY(_tarea)
  45.       _tarea = LTRIM(TRIM(STR(SELECT())))
  46.       _newarea = SELECT()
  47.    ELSEIF LEN(_tarea) = 1
  48.       SELECT &_tarea
  49.    ELSE
  50.       SELECT 0
  51.       USE ( scrdata + scrpath + _tarea )
  52.       SET INDEX TO ( scrdata + scrpath + _tarea )
  53.       _newarea = SELECT()
  54.    ENDIF
  55.  
  56.    IF "["$_tcode        && This tests to see if the variable passed is
  57.        _tme = &_tcode   && an array element which is passed by ref. by
  58.    ELSE                 && being passed to this function as a string;
  59.        _tme = _tcode    && rather than as a variable.
  60.    ENDIF
  61.  
  62.    IF ( !_req .AND. EMPTY(_tme) ) .OR. LASTREC() = 0
  63.       SELECT ( _newarea )
  64.       USE
  65.       SELECT ( _return )
  66.       RETURN(!_req)
  67.    ENDIF
  68.    
  69.    _hold = _tme
  70.    _ok = .F.
  71.    SEEK _tkey
  72.    IF FOUND()
  73.       _ok = .T.
  74.       LOCATE REST FOR _tme = &_mfield WHILE key = _tkey
  75.    ENDIF
  76.    IF !_ok
  77.       SELECT ( _newarea )
  78.       USE
  79.       SELECT ( _return )
  80.       RETURN(.T.)
  81.    ENDIF
  82.    _retrnval = FOUND()
  83.  
  84.    IF !_retrnval
  85.       *
  86.       * MPOP should test screen lenght of combined fields...
  87.       *
  88.       _wwhere= IF( (_wcol -12 < 2), 2, _wcol - 12)
  89.       _wdown = IF(_wrow > 15, 23 - _wrow, 7)
  90.       _wover = IF(_wcol > 50, 78 - _wcol, 25)
  91.       _wover = IF(_wover < 12, 12, _wover)
  92.       _pick = Dpop( _wrow, _wwhere , _wdown, _wover, _tarea, _sfields,"key=_tkey",.F.,.T.)
  93.       *
  94.    ELSE
  95.       _pick = RECNO()
  96.    ENDIF
  97.  
  98.    IF _pick > 0 .AND. TYPE("_farray") = "A"
  99.  
  100.       Storarray(_farray, _tarea, _pick)
  101.  
  102.    ENDIF
  103.    IF _pick > 0
  104.       GOTO _pick
  105.       IF "["$_tcode
  106.          &_tcode = &_mfield
  107.       ELSE
  108.          _tcode = &_mfield
  109.       ENDIF
  110.       @ _atsayr, _atsayc SAY &_mfield
  111.       _retrnval = .T.
  112.    ELSE
  113.       IF "["$_tcode
  114.          &_tcode = _hold
  115.       ELSE
  116.          _tcode = _hold
  117.       ENDIF
  118.       _retrnval = .T.
  119.    ENDIF
  120.    IF _newarea > 0
  121.       SELECT (_newarea)
  122.       USE
  123.       SELECT (_return)
  124.    ENDIF
  125.    RETURN(_retrnval)
  126.  
  127. * End of File
  128.