home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST181.PRG < prev    next >
Encoding:
Text File  |  1989-09-15  |  7.6 KB  |  286 lines
  1. ********************
  2.  
  3. FUNCTION Updtable
  4.  
  5.    PARAMETERS _uprow, _upcol, _updown, _upover, _upfile, _upsfield, _upgfield, _upfilter, _upbanner, _upcolor, _upvalids, _uppicts
  6.  
  7.    PRIVATE _w1, _x1, _y1, _z1, _tfields[Occurence("/", _upsfield)+1], _theader[Occurence("/", _upsfield)+1], _tcolor, _tfilt
  8.  
  9.    IF PCOUNT() = 6
  10.       _upgfield = _upsfield
  11.       _upfilter = ""
  12.       _upbanner = " ToolkiT Table Maintenance "
  13.       _upcolor = SETCOLOR()
  14.       _upvalids = ""
  15.       _uppicts = ""
  16.    ELSEIF PCOUNT() = 7
  17.       _upgfield = IF( EMPTY(_upgfield), _upsfield, _upgfield )
  18.       _upfilter = ""
  19.       _upbanner = " ToolkiT Table Maintenance "
  20.       _upcolor =  SETCOLOR()
  21.       _upvalids = ""
  22.       _uppicts = ""
  23.    ELSEIF PCOUNT() = 8
  24.       _upgfield = IF( EMPTY(_upgfield), _upsfield, _upgfield )
  25.       _upfilter = IF( EMPTY(_upfilter), "", _upfilter)
  26.       _upbanner = " ToolkiT Table Maintenance "
  27.       _upcolor =  SETCOLOR()
  28.       _upvalids = ""
  29.       _uppicts = ""
  30.    ELSEIF PCOUNT() = 9
  31.       _upgfield = IF( EMPTY(_upgfield), _upsfield, _upgfield )
  32.       _upfilter = IF( EMPTY(_upfilter), "", _upfilter)
  33.       _upbanner = IF( EMPT(_upbanner), " ToolkiT Table Maintenance ", _upbanner)
  34.       _upcolor =  SETCOLOR()
  35.       _upvalids = ""
  36.       _uppicts = ""
  37.    ELSEIF PCOUNT() = 10
  38.       _upgfield = IF( EMPTY(_upgfield), _upsfield, _upgfield )
  39.       _upfilter = IF( EMPTY(_upfilter), "", _upfilter)
  40.       _upbanner = IF( EMPT(_upbanner), " ToolkiT Table Maintenance ", _upbanner)
  41.       _upvalids = ""
  42.       _uppicts = ""
  43.    ELSEIF PCOUNT() = 11
  44.       _upgfield = IF( EMPTY(_upgfield), _upsfield, _upgfield )
  45.       _upfilter = IF( EMPTY(_upfilter), "", _upfilter)
  46.       _upbanner = IF( EMPT(_upbanner), " ToolkiT Table Maintenance ", _upbanner)
  47.       _uppicts  = ""
  48.    ENDIF
  49.  
  50.    _waitcolor = SETCOLOR()
  51.    _ifappend = .F.
  52.  
  53.    IF ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))
  54.       SETCOLOR(_upcolor)
  55.    ENDIF
  56.  
  57.    _retto = SELECT()
  58.  
  59.    IF EMPTY(_upfile)
  60.       _upfile = SELECT()
  61.    ELSE
  62.       IF LEN(_upfile) = 1
  63.          SELECT &_upfile.
  64.       ELSE
  65.          SELECT 0
  66.          USE (_upfile)
  67.       ENDIF
  68.    ENDIF
  69.  
  70.    SET KEY 28 TO 
  71.    SET KEY  7 TO 
  72.    SET KEY -9 TO
  73.    SET KEY 32 TO
  74.  
  75.    _tfilt = DBFILTER()
  76.    IF !EMPTY(_upfilter)
  77.       SET FILTER TO &_upfilter.
  78.       _lside = LTRIM(TRIM(SUBSTR(_upfilter, 1, AT("=", _upfilter)-1)))
  79.       _rside = LTRIM(TRIM(SUBSTR(_upfilter, 1 +AT("=", _upfilter))))
  80.       _rside = STRTRAN(STRTRAN(STRTRAN(STRTRAN(_rside, "'", ""), '"', ""), "[", ""), "]", "")
  81.       _oktoadd = !EMPTY(FINDFIELD(UPPER(_lside)))
  82.    ENDIF
  83.  
  84.    GO TOP
  85.  
  86.    _w1 = _uprow+1
  87.    _x1 = _upcol+1
  88.    _y1 = _w1 + (_updown - 2)
  89.    _z1 = _x1 + (_upover - 2)
  90.    _ttt = _upsfield
  91.  
  92.    FOR _qaz = 1 TO LEN(_tfields)
  93.       _tfields[_qaz] = FIELDNAME(VAL(PARSING(@_ttt)))
  94.       _theader[_qaz] = ";" + FORMALIZE(STRTRAN(_tfields[_qaz], "_", " "))
  95.    NEXT
  96.  
  97.    _ttt = _upsfield
  98.  
  99.    Windowpush(_uprow, _upcol, _uprow + _updown, _upcol+_upover)
  100.    @ _uprow, _upcol + 2 SAY _upbanner
  101.    DBEDIT(_w1,_x1, _y1,_z1, _tfields, "TABLEKEYS", .F., _theader)
  102.    IF LEN(_upfile) != 1
  103.       USE
  104.    ENDIF
  105.    Windowpop()
  106.    SELECT (_retto)
  107.    SET FILTER TO &_tfilt.
  108.    SETCOLOR(_waitcolor)
  109.    RETURN(DOSERROR() = 0)
  110.  
  111. *********************
  112.  
  113. FUNCTION Tablekeys
  114.  
  115.    PARAMETERS mode, p1
  116.  
  117.    IF LASTKEY() = 27
  118.       RETURN(0)
  119.    ENDIF
  120.  
  121.    IF TYPE("_oktoadd") = "U"
  122.       _oktoadd = .F.
  123.    ENDIF
  124.  
  125.    whatkey = LASTKEY()
  126.  
  127.    IF mode = 4
  128.       IF whatkey = 28     && Key help
  129.          Windowpush(_w1, _x1+1, _y1-1, _z1-3)
  130.          @ Wrow(1), Wcol(3) SAY "F1 Key is this screen"
  131.          @ Wrow(2), Wcol(3) SAY "F10 adds record"
  132.          @ Wrow(3), Wcol(3) SAY "SPACE BAR Edits Record"
  133.          @ Wrow(5), Wcol(3) SAY "Any key to return..."
  134.          INKEY(0)
  135.          Windowpop()
  136.  
  137.       ELSEIF whatkey = 7
  138.          Windowpush(_y1,_x1+1,_y1+2,_x1+35)
  139.          @ Wrow(1), Wcol(1) SAY "Are you sure to DELETE this? "
  140.          IF Prompt()
  141.             Clear_area(_y1,_x1+1,_y1+2,_x1+35)
  142.             @ Wrow(1), Wcol(1) SAY "One Moment.       Working.... "
  143.             DELETE
  144.             PACK
  145.             Clear_area()
  146.             @ Wrow(1), Wcol(1) SAY "Any key to quit."
  147.             INKEY(0)
  148.             Windowpop()
  149.             RETURN(2)
  150.          ENDIF
  151.          Windowpop()
  152.  
  153.       ELSEIF whatkey = -9 .OR. whatkey = 32            && Add/Edit record
  154.          *
  155.          * The key if filtered will have to be added automatically, I think
  156.          *
  157.          _ttx = _upgfield
  158.          _ifappend = (whatkey = -9)
  159.          IF _oktoadd
  160.             REPLACE &_lside. WITH _rside
  161.          ENDIF
  162.          DO WHILE !EMPTY(_ttx)
  163.             TABLEGET(Parsing(@_ttx), RECNO())
  164.             IF LASTKEY() = 27
  165.                EXIT
  166.             ENDIF
  167.          ENDDO
  168.          RETURN(2)
  169.  
  170.       ENDIF
  171.    ENDIF
  172.  
  173.    RETURN(1)
  174.  
  175. ********************
  176.  
  177. PROCEDURE Tableget
  178.  
  179.    PARAMETERS whatget, therecord
  180.  
  181.    *
  182.    * we will have to add the length of the get fitting into the
  183.    * display area.
  184.    *
  185.    IF TYPE("_oktoadd") = "U"
  186.       _oktoadd = .F.
  187.    ENDIF
  188.  
  189.    _getit = FIELDNAME(VAL(whatget))
  190.    _sayit = Formalize(STRTRAN(_getit, "_", " "))
  191.    IF EMPTY(_getit)
  192.       RETURN
  193.    ENDIF
  194.    IF TYPE("_upvalids") = "A"
  195.       _newx = _upgfield
  196.       _cnt = 1
  197.       _validexp = ".T."
  198.       DO WHILE !EMPTY(_newx)
  199.          _newvar = VAL(Parsing(@_newx))
  200.          IF _newvar = VAL(whatget)
  201.             _validexp = _upvalids[_cnt]
  202.             EXIT
  203.          ELSE
  204.             _cnt = _cnt + 1
  205.          ENDIF
  206.       ENDDO
  207.    ELSE
  208.       _validexp = ".T."
  209.    ENDIF
  210.  
  211.    IF TYPE(_validexp) == "U" .OR. TYPE(_validexp) = "UE"
  212.       IF "("$_validexp
  213.          IF TYPE( Parsing(_validexp, "(" ) + "()" ) = "UI"
  214.          ELSE
  215.             _validexp = ".T."
  216.          ENDIF
  217.       ELSE
  218.          _validexp = ".T."
  219.       ENDIF
  220.    ELSE
  221.       _validexp = ".T."
  222.    ENDIF
  223.  
  224.    IF TYPE(_getit) = "M"
  225.       Windowpush(_y1,_x1+1,_y1+3,_x1+47)
  226.    ELSE
  227.       Windowpush(_y1,_x1+1,_y1+2,_x1+35)
  228.    ENDIF
  229.    IF LASTREC() = 0 && .OR. LASTKEY() = 24
  230.       _ifappend = .T.
  231.    ELSE
  232.       GO therecord
  233.       IF RECNO() > LASTREC()
  234.          GO LASTREC()
  235.       ENDIF
  236.    ENDIF
  237.    IF _ifappend
  238.       APPEND BLANK
  239.       _ifappend = .F.
  240.    ENDIF
  241.    IF _oktoadd
  242.       REPLACE &_lside. WITH _rside
  243.    ENDIF
  244.    SET CURSOR ON
  245.    _holding = &_getit
  246.    IF TYPE("_uppicts") = "A"
  247.       _newx = _upgfield
  248.       _cnt = 1
  249.       _thepict = ""
  250.       DO WHILE !EMPTY(_newx)
  251.          _newvar = VAL(Parsing(@_newx))
  252.          IF _newvar = VAL(whatget)
  253.             _thepict = _uppicts[_cnt]
  254.             EXIT
  255.          ELSE
  256.             _cnt = _cnt + 1
  257.          ENDIF
  258.       ENDDO
  259.       IF TYPE(_getit) = "M"
  260.          SET FUNCTION 10 TO CHR(23)
  261.          @ Wrow(1),Wcol(3) SAY _sayit + " =>" 
  262.          _holding = MEMOTRAN(MEMOEDIT(_holding, ROW(),COL(),ROW()+1,IF( (COL()+30 > Wcol(Wwidth())+1), Wcol(Wwidth())+1, COL()+30),.T.,"",COL()+70))
  263.          SET FUNCTION 10 TO ""
  264.       ELSE
  265.          @ Wrow(1),Wcol(3) SAY _sayit + " =>" GET _holding PICTURE _thepict VALID &_validexp.
  266.       ENDIF
  267.    ELSE
  268.       IF TYPE(_getit) = "M"
  269.          SET FUNCTION 10 TO CHR(23)
  270.          @ Wrow(1),Wcol(3) SAY _sayit + " =>" 
  271.          _holding = MEMOTRAN(MEMOEDIT(_holding, ROW(),COL(),ROW()+1,IF( (COL()+30 > Wcol(Wwidth())+1), Wcol(Wwidth())+1, COL()+30),.T.,"",COL()+70))
  272.          SET FUNCTION 10 TO ""
  273.       ELSE
  274.          @ Wrow(1),Wcol(3) SAY _sayit + " =>" GET _holding VALID &_validexp.
  275.       ENDIF
  276.    ENDIF
  277.    READ
  278.    IF LASTKEY() != 27
  279.       REPLACE &_getit. WITH _holding
  280.    ENDIF
  281.    SET CURSOR OFF
  282.    Windowpop()
  283.  
  284. * End of File
  285.  
  286.