home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETPRGS.EXE / GETS01.PRG < prev    next >
Encoding:
Text File  |  1992-03-08  |  8.9 KB  |  319 lines
  1.     // Gets01.prg
  2.     //
  3.     // Lookup function in valid clause using TBrowse objects to browse
  4.     // a range of records
  5.     //
  6.     // N.B. - The TBrowse routines used in here are included in the
  7.     // TBrowse paper's library and documented therein
  8.  
  9.     MEMVAR GetList
  10.  
  11.     #xtranslate GET_NUMBER(<cName>)                                   ;
  12.                 =>                                                    ;
  13.                 Ascan(GetList, {|o| Trim(Upper(o:name)) == <cName>})
  14.  
  15.     #xtranslate GET_NUMBER(<cName>, <gl>)                             ;
  16.                 =>                                                    ;
  17.                 Ascan(<gl>, {|o| Trim(Upper(o:name)) == <cName>})
  18.  
  19.     #include "Inkey.ch"
  20.  
  21.     #define INC_LAST(c) Substr(c, 1, Len(c) - 1) + ;
  22.                         Chr(Asc(Substr(c, 1, Len(c))) + 1)
  23.  
  24.     FUNCTION Gets01
  25.  
  26.     FIELD Lname, Fname, Addr1, Addr2, Addr3, Addr4, AcBal IN Tbdbf1
  27.  
  28.     LOCAL cLname, cFname
  29.     LOCAL cAddr1, cAddr2, cAddr3, cAddr4
  30.     LOCAL nAcBal
  31.     LOCAL nRecno
  32.  
  33.       USE TbDbf1
  34.       IF !File("Tbdbf1.ntx")
  35.         INDEX ON Upper(Lname + Fname) TO Tbdbf1
  36.       ELSE
  37.         SET INDEX TO Tbdbf1
  38.       ENDIF
  39.       CLEAR SCREEN
  40.  
  41.       // Get blank values of these fields
  42.       nRecno := Recno()
  43.  
  44.       GOTO 0
  45.       cLname := Lname
  46.       cFname := Fname
  47.       cAddr1 := Addr1
  48.       cAddr2 := Addr2
  49.       cAddr3 := Addr3
  50.       cAddr4 := Addr4
  51.       nAcBal := AcBal
  52.       GOTO nRecno
  53.  
  54.       @ 10, 10 SAY "  Enter Lname" GET cLname VALID {|o| Lookup(o, GetList)}
  55.       @ 11, 10 SAY "  Enter Fname" GET cFname
  56.       @ 12, 10 SAY "Enter Address" GET cAddr1
  57.       @ 13, 10 SAY "             " GET cAddr2
  58.       @ 14, 10 SAY "             " GET cAddr3
  59.       @ 15, 10 SAY "             " GET cAddr4
  60.       @ 16, 10 SAY "             " GET nAcBal
  61.  
  62.       READ
  63.  
  64.     RETURN NIL
  65.  
  66.  
  67.     #define WIN_TOP     12
  68.     #define WIN_LEFT    30
  69.     #define WIN_BOTTOM  20
  70.     #define WIN_RIGHT   79
  71.  
  72.     FUNCTION LookUp(o, GetList)
  73.  
  74.     FIELD Lname, Fname, Addr1, Addr2, Addr3, Addr4, AcBal IN Tbdbf1
  75.  
  76.     LOCAL cSearcher := Upper(Trim(o:varGet()))
  77.     LOCAL bFirst := {|| DbSeek(cSearcher) }
  78.     LOCAL bLast  := {|| iif(Empty(cSearcher), ;
  79.                             DbGoBottom(), ;
  80.                             (DbSeek(INC_LAST(cSearcher), .T.), ;
  81.                              DbSkip(-1))) }
  82.  
  83.     LOCAL bWhile := {|| Upper(Lname) = cSearcher }
  84.     LOCAL bFor   := {|| .T. }
  85.     LOCAL oTbr   := TBForWhile(bFirst, bLast, bFor, bWhile)
  86.     LOCAL oTbc
  87.     LOCAL cSaveScr := SaveScreen(WIN_TOP, WIN_LEFT, ;
  88.                                  WIN_BOTTOM, WIN_RIGHT)
  89.     LOCAL aKeyHandler := { ;
  90.                            { K_ENTER, {|| .T. } } ;
  91.                          }
  92.     LOCAL nGet
  93.  
  94.       oTbc := TBColumnNew("Last Name", {|| Lname })
  95.       oTbc:width := 15
  96.       oTbr:addColumn(oTbc)
  97.  
  98.       oTbc := TBColumnNew("First Name", {|| Fname })
  99.       oTbc:width := 10
  100.       oTbr:addColumn(oTbc)
  101.  
  102.       oTbc := TBColumnNew("Address", {|| Addr1 })
  103.       oTbc:width := 15
  104.       oTbr:addColumn(oTbc)
  105.  
  106.       oTbc := TBColumnNew("Balance", {|| AcBal })
  107.       oTbc:width := 15
  108.       oTbr:addColumn(oTbc)
  109.  
  110.       oTbr:goTop()
  111.       IF !Eval(bWhile)
  112.         Alert("No Matching Records", {"OK"})
  113.       ELSE
  114.         @ WIN_TOP, WIN_LEFT CLEAR TO WIN_BOTTOM, WIN_RIGHT
  115.         @ WIN_TOP, WIN_LEFT TO WIN_BOTTOM, WIN_RIGHT
  116.         oTbr:nTop    := WIN_TOP    + 1
  117.         oTbr:nLeft   := WIN_LEFT   + 1
  118.         oTbr:nBottom := WIN_BOTTOM - 1
  119.         oTbr:nRight  := WIN_RIGHT  - 1
  120.  
  121.         // Exit on Enter key
  122.         MyBrowse2(oTbr,, aKeyHandler)
  123.         IF LastKey() != K_ESC
  124.           o:varPut(Lname)
  125.           nGet := GET_NUMBER("CFNAME")
  126.           GetList[nGet]:VarPut(Fname)
  127.  
  128.           nGet := GET_NUMBER("CADDR1")
  129.           GetList[nGet]:VarPut(Addr1)
  130.  
  131.           nGet := GET_NUMBER("CADDR2")
  132.           GetList[nGet]:VarPut(Addr2)
  133.  
  134.           nGet := GET_NUMBER("CADDR3")
  135.           GetList[nGet]:VarPut(Addr3)
  136.  
  137.           nGet := GET_NUMBER("CADDR4")
  138.           GetList[nGet]:VarPut(Addr4)
  139.  
  140.           nGet := GET_NUMBER("NACBAL")
  141.           GetList[nGet]:VarPut(AcBal)
  142.           IF Acbal < 0
  143.             GetList[nGet]:colorSpec := "R/B,B/R"
  144.           ELSE
  145.             GetList[nGet]:colorSpec := "N/W,N/W"
  146.           ENDIF
  147.  
  148.         ENDIF
  149.       ENDIF
  150.  
  151.       RestScreen(WIN_TOP, WIN_LEFT, WIN_BOTTOM, WIN_RIGHT, cSaveScr)
  152.  
  153.       Aeval(GetList, {|o| o:display() })
  154.  
  155.     RETURN .T.
  156.  
  157.  
  158.     // N.B. - These routines are included in the TBrowse paper's
  159.     // library and documented therein
  160.  
  161.     // Default column separator
  162.     #define DEF_CSEP  " " + chr(179) + " "
  163.  
  164.     // Default heading separator
  165.     #define DEF_HSEP chr(205) + chr(209) + chr(205)
  166.  
  167.     // Default footing separator
  168.     #define DEF_FSEP chr(205) + chr(207) + chr(205)
  169.  
  170.     FUNCTION TBForWhile(bFirst, bLast, bFor, bWhile)
  171.  
  172.     LOCAL oTbr := TBrowseNew()
  173.  
  174.       oTbr:goTopBlock    := {||  TBFwFirst(bFirst, bWhile, bFor) }
  175.       oTbr:goBottomBlock := {||  TBFwLast(bLast, bWhile, bFor) }
  176.       oTbr:skipBlock     := {|n| TBFwSkip(n, bWhile, bFor) }
  177.  
  178.       oTbr:headSep := DEF_HSEP
  179.       oTbr:footSep := DEF_FSEP
  180.       oTbr:colSep  := DEF_CSEP
  181.  
  182.     RETURN oTbr
  183.  
  184.     FUNCTION TBFwFirst(bGoFirst, bWhile, bFor)
  185.     
  186.       eval(bGoFirst)
  187.       DO WHILE !eof() .AND. eval(bWhile) .AND. !eval(bFor)
  188.         SKIP
  189.       ENDDO
  190.     
  191.       IF !eval(bWhile)
  192.         // no records match filter - could also be at eof already here
  193.         GOTO 0
  194.       ENDIF
  195.     
  196.     RETURN NIL
  197.  
  198.     
  199.     FUNCTION TBFwLast(bGoLast, bWhile, bFor)
  200.     
  201.       eval(bGoLast)
  202.       DO WHILE !bof() .AND. eval(bWhile) .AND. !eval(bFor)
  203.         SKIP -1
  204.       ENDDO
  205.     
  206.       IF bof() .OR. !eval(bWhile)
  207.         // No records match scope
  208.         GOTO 0
  209.       ENDIF
  210.     
  211.     RETURN NIL
  212.  
  213.  
  214.     FUNCTION TBFwSkip(nToSkip, bWhile, bFor)
  215.     
  216.     LOCAL nSkipped := 0, ;
  217.           nLastValidRecNum := Recno()
  218.  
  219.       IF nToSkip = 0
  220.         SKIP 0
  221.         RETURN 0
  222.       ENDIF
  223.  
  224.       IF nToSkip > 0
  225.         DO WHILE nSkipped < nToSkip .AND. !eof() .AND. eval(bWhile)
  226.           SKIP
  227.           // Note the last clause here makes a big speed difference
  228.           DO WHILE !eval(bFor) .AND. !eof() .AND. eval(bWhile)
  229.             SKIP
  230.           ENDDO
  231.           IF Eval(bWhile) .AND. !eof()
  232.             // Found a new record matching the scope
  233.             nSkipped++
  234.             nLastValidRecNum := Recno()
  235.           ENDIF
  236.         ENDDO
  237.     
  238.         IF eof() .OR. !eval(bWhile)
  239.           GOTO nLastValidRecNum
  240.         ENDIF
  241.       ELSE
  242.         DO WHILE nSkipped > nToSkip .AND. !bof() .AND. eval(bWhile)
  243.           SKIP -1
  244.           // Note the last clause here makes a big speed difference
  245.           DO WHILE !eval(bFor) .AND. !bof() .AND. eval(bWhile)
  246.             SKIP -1
  247.           ENDDO
  248.           IF Eval(bWhile) .AND. !bof()
  249.             nSkipped--
  250.             nLastValidRecNum := Recno()
  251.           ENDIF
  252.         ENDDO
  253.         IF !eval(bWhile) .OR. bof()
  254.           GOTO nLastValidRecNum
  255.         ENDIF
  256.       ENDIF
  257.  
  258.     RETURN nSkipped
  259.  
  260.     FUNCTION MyBrowse2(oTbr, aBeforepairs, aAfterPairs)
  261.  
  262.     LOCAL nKey
  263.     LOCAL lExitRequested := .F.
  264.     LOCAL nElem
  265.  
  266.       // set defaults for before and after keys
  267.       aBeforePairs := iif(aBeforePairs == NIL, {}, aBeforePairs)
  268.       aAfterpairs  := iif(aAfterPairs  == NIL, {}, aAfterPairs)
  269.  
  270.       DO WHILE !lExitRequested
  271.         FullStabilize(oTbr)
  272.         nKey := inkey(0)
  273.         nElem := ascan(aBeforePairs, ;
  274.                        {|e| e[1] == nKey })
  275.         IF nElem > 0
  276.           lExitRequested := eval(aBeforePairs[nElem, 2], oTbr)
  277.         ELSEIF !stdMeth(nKey, oTbr) .AND. oTbr:stable
  278.           nElem := ascan(aAfterPairs, ;
  279.                          {|e| e[1] == nKey })
  280.           lExitRequested := iif(nElem > 0, ;
  281.                                 eval(aAfterPairs[nElem, 2], oTbr), ;
  282.                                 nKey == K_ESC)
  283.         ENDIF
  284.       ENDDO
  285.  
  286.     RETURN NIL
  287.  
  288.     FUNCTION StdMeth(nKey, oTbr)
  289.  
  290.     LOCAL lKeyHandled := .T.
  291.  
  292.       DO CASE
  293.         CASE nKey == K_DOWN;       oTbr:down()
  294.         CASE nKey == K_UP;         oTbr:up()
  295.         CASE nKey == K_PGDN;       oTbr:pageDown()
  296.         CASE nKey == K_PGUP;       oTbr:pageUp()
  297.         CASE nKey == K_CTRL_PGUP;  oTbr:goTop()
  298.         CASE nKey == K_CTRL_PGDN;  oTbr:goBottom()
  299.         CASE nKey == K_RIGHT;      oTbr:right()
  300.         CASE nKey == K_LEFT;       oTbr:left()
  301.         CASE nKey == K_HOME;       oTbr:home()
  302.         CASE nKey == K_END;        oTbr:end()
  303.         CASE nKey == K_CTRL_LEFT;  oTbr:panLeft()
  304.         CASE nKey == K_CTRL_RIGHT; oTbr:panRight()
  305.         CASE nKey == K_CTRL_HOME;  oTbr:panHome()
  306.         CASE nKey == K_CTRL_END;   oTbr:panEnd()
  307.         OTHERWISE;                 lKeyHandled := .F.
  308.       ENDCASE
  309.  
  310.     RETURN lKeyHandled
  311.  
  312.  
  313.     FUNCTION FullStabilize(oTbr)
  314.  
  315.       DO WHILE !oTbr:stabilize()
  316.       ENDDO
  317.  
  318.     RETURN NIL
  319.