home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST46.PRG < prev    next >
Encoding:
Text File  |  1989-08-17  |  9.3 KB  |  354 lines
  1. ********************
  2.  
  3. FUNCTION Mpop
  4.  
  5.    PARAMETERS _top, _left, _down, _over, _file, _fieldlist, _filt, _unique, _shadow, _newcolor, _seekit
  6.  
  7.    * This function is designed to throw a list box to the screen
  8.    * given the first four parameters as screen position, a given
  9.    * file/select area
  10.  
  11.    EXTERNAL Breakout
  12.  
  13.    PRIVATE _ncolor, _okseek, _mpoptop, _mpopleft, _llength, _mpopbot, _mpoprht
  14.    PRIVATE _ccolor,   _retarea, _array, _fscr, _bscr, _hbottom, _start
  15.    PRIVATE _preset,   _begset,  _scrno, _popopt, _dpopt, _opopt, _unistring
  16.    PRIVATE _backitup, _qaz, _promptit, _optpop, _pass_to, _close
  17.  
  18.  
  19.    IF PCOUNT() = 6
  20.       STORE .F. TO _filt, _unique, _shadow, _newcolor
  21.    ELSEIF PCOUNT() = 7
  22.       STORE .F. TO _unique, _shadow, _newcolor
  23.    ELSEIF PCOUNT() = 8
  24.       STORE .F. TO _shadow, _newcolor
  25.    ELSEIF PCOUNT() = 9
  26.       STORE .F. TO _newcolor
  27.    ENDIF
  28.  
  29.    _okseek = IF( (TYPE("_seekit") = "U"), .T., .F.)
  30.    _close  = .F.
  31.  
  32.    _mpoptop  =  _top    && The top coordinate
  33.    _mpopleft =  _left    && The _left coordinate
  34.  
  35.    _llength = (_over-2)
  36.  
  37.    _mpopbot = _top  + _down + IF(_shadow, 1, 0)
  38.    _mpoprht = _left + _over + IF(_shadow, 2, 0)
  39.  
  40.    _ccolor = SETCOLOR()
  41.    _retarea = SELECT()
  42.    DECLARE _array[_down]
  43.    SET KEY 18 TO Uppage
  44.    SET KEY  3 TO Downpage
  45.    STORE "" TO _fscr, _bscr
  46.  
  47.    IF (_mpoprht - _mpopleft) < 8     && Handle the Exit Key
  48.       _mpoprht = _mpopleft + 8
  49.    ENDIF
  50.    
  51.    IF _mpopleft+_mpoprht > 78        && Adjust the right/left sides!
  52.       _mpopleft = 78 - _mpoprht
  53.    ENDIF
  54.       
  55.    _bscr = SAVESCREEN( _mpoptop, _mpopleft, _mpopbot, _mpoprht)
  56.  
  57.    IF !EMPTY(_newcolor)
  58.       SETCOLOR(_newcolor)
  59.    ENDIF
  60.  
  61.    Clear_area( _top, _left, _top+_down, _left+_over )
  62.  
  63.    @ _top, _left TO _top+_down, _left+_over DOUBLE
  64.    IF _shadow
  65.       Shadow(_top, _left, _top+_down, _left+_over)
  66.    ENDIF
  67.  
  68.    _fscr = SAVESCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht)
  69.  
  70.    IF TYPE("_file") = "C"
  71.       IF LEN(_file) = 1 .OR. ( VAL(_file) >= 1 .AND. VAL(_file) <= 200 )
  72.          SELECT &_file.
  73.       ELSEIF EMPTY(_file)
  74.          * this means that the file is already
  75.          * selected because it is being called with
  76.          * the extended () feature or the Mpop()
  77.          * needs to work in the current and open
  78.          * database
  79.          IF EMPTY(ALIAS())
  80.             RETURN(0)
  81.          ENDIF
  82.       ELSE
  83.          SELECT 0
  84.          USE (_file)
  85.          _close = .T.
  86.       ENDIF
  87.    ELSEIF TYPE("_file") = "N"
  88.       SELECT (_file)
  89.    ELSE
  90.       IF EMPTY(_file)
  91.          * this means that the file is already
  92.          * selected because it is being called with
  93.          * the extended () feature or the Mpop()
  94.          * needs to work in the current and open
  95.          * database
  96.          IF EMPTY(ALIAS())
  97.             RETURN(0)
  98.          ENDIF
  99.       ENDIF
  100.    ENDIF
  101.  
  102.    IF LASTREC() = 0
  103.       SELECT (_retarea)
  104.       SETCOLOR(_ccolor)
  105.       RESTSCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht, _bscr)
  106.       RETURN(0)
  107.    ENDIF
  108.  
  109.    IF EMPTY(_filt)
  110.       SET FILTER TO
  111.    ELSE
  112.       _filt = _filt + " .AND. BREAKOUT()"
  113.       IF !(TYPE(_filt) == "U") .OR. !(TYPE(_filt) == "UE")
  114.          SET FILTER TO &_filt.
  115.       ENDIF
  116.    ENDIF
  117.  
  118.    IF _okseek .AND. TYPE("_seekit") != "U"
  119.       IF !EMPTY(_seekit)
  120.          SET SOFTSEEK ON
  121.          SEEK _seekit
  122.          SET SOFTSEEK OFF
  123.          IF !FOUND()
  124.             GO TOP
  125.          ENDIF
  126.       ELSE
  127.          GO TOP
  128.       ENDIF
  129.    ELSE
  130.       GO TOP
  131.    ENDIF
  132.  
  133.    STORE .T.     TO _hbottom
  134.    STORE RECNO() TO _start,    _preset,  _begset, next_set
  135.    STORE 1       TO _scrno, _popopt
  136.    STORE .F. TO down, up
  137.    DO WHILE .T.
  138.       _dpopt = _top + 1
  139.       _opopt = _left + 1
  140.       RESTSCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht, _fscr)
  141.       _preset = _begset
  142.       _begset = RECNO()
  143.       _unistring = ""
  144.       _backitup = 0
  145.       FOR _qaz = 1 TO _down-3
  146.            _array[_qaz] = RECNO()
  147.            _promptit = Buildpop(_fieldlist, _over-2)
  148.            IF LEN(_promptit) > _llength
  149.               _promptit = SUBSTR(_promptit, 1, _llength+1)
  150.            ENDIF
  151.            IF _unique
  152.               IF Occurence(_promptit, _unistring) = 0
  153.                  @ _dpopt, _opopt PROMPT _promptit
  154.                  _dpopt = _dpopt + 1
  155.                  _unistring = _unistring + _promptit
  156.               ELSE
  157.                  _qaz = _qaz - 1
  158.               ENDIF
  159.            ELSE
  160.               @ _dpopt, _opopt PROMPT _promptit
  161.               _dpopt = _dpopt + 1
  162.            ENDIF
  163.            _backitup = _backitup + 1
  164.            SKIP
  165.            IF EOF()
  166.               _hbottom = .T.
  167.               EXIT
  168.            ELSE
  169.               next_set = RECNO()
  170.            ENDIF
  171.       NEXT
  172.       IF EOF()
  173.            Lastscrn()
  174.       ELSE
  175.           Last_part(IF((_scrno  > 1), " PgUp ", "ESC to Exit"))                             && Not the first screen
  176.       ENDIF
  177.  
  178.       GO _start
  179.       MENU TO _optpop
  180.       DO CASE
  181.       CASE LASTKEY() = 27
  182.          IF up
  183.             up = .F.
  184.              IF _scrno > 1
  185.                 _optpop = 1
  186.                 _scrno = _scrno - 1
  187.                 IF _scrno < 2
  188.                    _scrno = 1
  189.                    IF _okseek .AND. TYPE("_seekit") != "U"
  190.                        IF !EMPTY(_seekit)
  191.                         SET SOFTSEEK ON
  192.                         SEEK _seekit
  193.                           SET SOFTSEEK OFF
  194.                           IF !FOUND()
  195.                            GO TOP
  196.                         ENDIF
  197.                        ELSE
  198.                         GO TOP
  199.                      ENDIF
  200.                    ELSE
  201.                        GO TOP
  202.                   ENDIF
  203.                ELSE
  204.                   IF !_hbottom
  205.                      GO _begset
  206.                      SKIP ((_backitup) * -1)
  207.                   ELSE
  208.                       GO _preset
  209.                    ENDIF
  210.                 ENDIF
  211.             ELSE
  212.                 RESTSCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht, _bscr)
  213.                 STORE "" TO _bscr, _fscr
  214.                 IF _close
  215.                    USE
  216.                 ENDIF
  217.                SET KEY 18 TO 
  218.                SET KEY  3 TO 
  219.                 SET FILTER TO
  220.                IF !EMPTY(_file)
  221.                     SELECT (_retarea)
  222.                ENDIF
  223.                 SETCOLOR(_ccolor)
  224.                 RETURN(0)
  225.              ENDIF
  226.              IF _hbottom
  227.                 _hbottom = .F.
  228.              ENDIF
  229.          ELSEIF down
  230.             down = .F.
  231.              _optpop = 1
  232.              GO next_set
  233.              _scrno = _scrno + 1
  234.          ELSE
  235.             RESTSCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht, _bscr)
  236.               STORE "" TO _bscr, _fscr
  237.              IF _close
  238.                 USE
  239.              ENDIF
  240.             SET KEY 18 TO 
  241.             SET KEY  3 TO 
  242.              SET FILTER TO
  243.             IF !EMPTY(_file)
  244.                  SELECT (_retarea)
  245.             ENDIF
  246.              SETCOLOR(_ccolor)
  247.              RETURN(0)
  248.          ENDIF
  249.       OTHERWISE
  250.           DO CASE
  251.           CASE _optpop = _down -1    && Down a page
  252.           CASE _optpop = _down -2
  253.           OTHERWISE
  254.              IF TYPE("_array[_optpop]") = "U"
  255.                 _pass_to = 0
  256.              ELSE
  257.                _pass_to = _array[_optpop]
  258.              ENDIF
  259.              RESTSCREEN(_mpoptop, _mpopleft, _mpopbot, _mpoprht, _bscr)
  260.              STORE "" TO _bscr, _fscr
  261.              IF _close
  262.                USE
  263.             ENDIF
  264.             SET KEY 18 TO 
  265.             SET KEY  3 TO 
  266.              SET FILTER TO
  267.             IF !EMPTY(_file)
  268.                  SELECT (_retarea)
  269.             ENDIF
  270.              SETCOLOR(_ccolor)
  271.              RETURN(_pass_to)
  272.           ENDCASE
  273.       ENDCASE
  274.    ENDDO
  275.  
  276. ********************
  277.  
  278. FUNCTION Buildpop
  279.  
  280.    PARAMETERS _fieldlist, _thelength
  281.  
  282.    PRIVATE _actfield, _passfield, _buildstr
  283.  
  284.    _actfield = ""
  285.    _passfield= ""
  286.    _buildstr = " "
  287.    
  288.    DO WHILE !EMPTY(_fieldlist)
  289.       _actfield = FIELDNAME(VAL(PARSING(@_fieldlist)))      && The name of the field passed by the PARSING function from the passed Fieldlist.
  290.       _passfield = &_actfield.                              && The acutal contents of the field expressed by ACT_FIELD.
  291.       _buildstr = _buildstr + STRVALUE(_passfield) + " " + CHR(186) + " "
  292.    ENDDO
  293.    _buildstr = SUBSTR(_buildstr, 1, LEN(_buildstr) - 2)
  294.    IF LEN(_buildstr) >= _thelength
  295.       RETURN(SUBSTR(_buildstr, 1, _thelength - 1) + "  ")
  296.    ELSE
  297.       RETURN(FILL_OUT(_buildstr, _thelength+1))
  298.    ENDIF
  299.    
  300. ********************
  301.  
  302. PROCEDURE Downpage
  303.  
  304.    PARAMETERS p, l, v
  305.  
  306.    KEYBOARD CHR(27)
  307.    down = .T.
  308.    
  309. ********************
  310.  
  311. PROCEDURE Uppage
  312.  
  313.    PARAMETERS p, l, v
  314.    
  315.    KEYBOARD CHR(27)
  316.    up = .T.
  317.  
  318. ********************
  319.  
  320. PROCEDURE Lastscrn
  321.  
  322.    IF TYPE("_llength") = "U"
  323.       _llength = _over - 2
  324.    ENDIF
  325.  
  326.    IF _scrno > 1
  327.       @ _top + _down + IF( _over <= 10, 1, -2), _left + IF( _over <= 10, 0, 1) SAY " " + Fill_out(" PgUp ", _llength)
  328.    ELSE
  329.       @ _top + _down + IF( (_over <= 10), 1, -2), IF( (_over <=10), _left, _left+1) SAY Fill_out(" ESC to Exit", _llength)
  330.    ENDIF
  331.    
  332. ********************
  333.  
  334. PROCEDURE Notlastscr
  335.  
  336. * This was suddenly removed from the ToolkiT 2.0
  337.  
  338. ********************
  339.  
  340. PROCEDURE Last_part
  341.  
  342.    PARAMETER _laststr
  343.  
  344.    IF _over <= 10
  345.       @ _top+_down + 1, _left+1 SAY " " + FILL_OUT(_laststr, _over-2)
  346.       @ _top+_down + 2, _left+1 SAY " " + FILL_OUT(" PgDn ", _over-2)
  347.    ELSE
  348.       @ _top+_down - 2, _left+1 SAY " " + FILL_OUT(_laststr, _over-2)
  349.       @ _top+_down - 1, _left+1 SAY " " + FILL_OUT(" PgDn ", _over-2)
  350.    ENDIF
  351.    
  352. * End of File
  353.  
  354.