home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETEXS.EXE / GETEX04.PRG < prev    next >
Encoding:
Text File  |  1992-03-16  |  6.3 KB  |  269 lines
  1. /***
  2. * Getex04.prg
  3. *
  4. * Get reader calling code block after each keystroke
  5. *
  6. * The example "on key block" uses a TBrowse object to display just the
  7. * records matching the entered key.
  8. *
  9. * N.B. - The TBrowse routines used in here are included in the
  10. *        TBrowse paper's library and documented therein
  11. */
  12.  
  13. #include "Getexit.ch"
  14. #include "Setcurs.ch"
  15.  
  16. #command @ <row>, <col> GET <var>                                          ;
  17.                         [<clauses,...>]                                    ;
  18.                         ON KEY <b>                                         ;
  19.                         [<moreClauses,...>]                                ;
  20.                                                                            ;
  21.       => @ <row>, <col> GET <var>                                          ;
  22.                         [<clauses>]                                        ;
  23.                         SEND reader := {|oGet| OnKeyReader(oGet, <{b}> ) } ;
  24.                         [<moreClauses>]
  25.  
  26. #define INC_LAST(c) Substr(c, 1, Len(c) - 1) + ;
  27.                     Chr(Asc(Substr(c, 1, Len(c))) + 1)
  28.  
  29. #define K_PLUS   43
  30. #define K_MINUS  45
  31.  
  32. #define WIN_TOP     12
  33. #define WIN_LEFT    30
  34. #define WIN_BOTTOM  23
  35. #define WIN_RIGHT   79
  36.  
  37. // Default column separator
  38. #define DEF_CSEP  " " + chr(179) + " "
  39.  
  40. // Default heading separator
  41. #define DEF_HSEP chr(205) + chr(209) + chr(205)
  42.  
  43. // Default footing separator
  44. #define DEF_FSEP chr(205) + chr(207) + chr(205)
  45.  
  46.  
  47. MEMVAR GetList
  48.  
  49. FUNCTION Getex04
  50.  
  51. FIELD Lname, Fname, Addr1, AcBal IN Tbdbf1
  52.  
  53. LOCAL cSearcher := ""
  54. LOCAL cLname
  55. LOCAL bFirst := {|| DbSeek(cSearcher) }
  56. LOCAL bLast  := {|| iif(Empty(cSearcher), ;
  57.                         DbGoBottom(), ;
  58.                         (DbSeek(INC_LAST(cSearcher), .T.), ;
  59.                          DbSkip(-1))) }
  60.  
  61. LOCAL bWhile := {|| Upper(Lname) = cSearcher }
  62. LOCAL bFor   := {|| .T. }
  63. LOCAL oTbr   := TBForWhile(bFirst, bLast, bFor, bWhile)
  64. LOCAL oTbc
  65. LOCAL cSaveScr := SaveScreen(WIN_TOP, WIN_LEFT, ;
  66.                              WIN_BOTTOM, WIN_RIGHT)
  67.  
  68.   oTbc := TBColumnNew("Last Name", {|| Lname })
  69.   oTbc:width := 15
  70.   oTbr:addColumn(oTbc)
  71.  
  72.   oTbc := TBColumnNew("First Name", {|| Fname })
  73.   oTbc:width := 10
  74.   oTbr:addColumn(oTbc)
  75.  
  76.   oTbc := TBColumnNew("Address", {|| Addr1 })
  77.   oTbc:width := 15
  78.   oTbr:addColumn(oTbc)
  79.  
  80.   oTbc := TBColumnNew("Balance", {|| AcBal })
  81.   oTbc:width := 15
  82.   oTbr:addColumn(oTbc)
  83.  
  84.   USE TbDbf1
  85.   IF !File("Tbdbf1.ntx")
  86.     INDEX ON Upper(Lname + Fname) TO Tbdbf1
  87.   ELSE
  88.     SET INDEX TO Tbdbf1
  89.   ENDIF
  90.  
  91.   CLEAR SCREEN
  92.   cSaveScr := SaveScreen(WIN_TOP, WIN_LEFT, ;
  93.                          WIN_BOTTOM, WIN_RIGHT)
  94.   @ WIN_TOP, WIN_LEFT CLEAR TO WIN_BOTTOM, WIN_RIGHT
  95.   @ WIN_TOP, WIN_LEFT TO WIN_BOTTOM, WIN_RIGHT
  96.   oTbr:nTop    := WIN_TOP    + 1
  97.   oTbr:nLeft   := WIN_LEFT   + 1
  98.   oTbr:nBottom := WIN_BOTTOM - 1
  99.   oTbr:nRight  := WIN_RIGHT  - 1
  100.   oTbr:autoLite := .F.
  101.  
  102.   // Kick-start the TBrowse window
  103.   TBDisplay(oTbr)
  104.  
  105.   cLname := Space(Len(Lname))
  106.   @ 10, 10 SAY "Enter Lname" GET cLname ;
  107.     ON KEY {|o| cSearcher := Upper(Trim(o:buffer)), ;
  108.                 TBDisplay(oTbr) }
  109.   READ
  110.  
  111.   RestScreen(WIN_TOP, WIN_LEFT, WIN_BOTTOM, WIN_RIGHT, cSaveScr)
  112.  
  113. RETURN NIL
  114.  
  115.  
  116. proc OnKeyReader( Get, b )
  117.  
  118. LOCAL nKey
  119.  
  120.   // read the GET if the WHEN condition is satisfied
  121.   IF ( GetPreValidate(get) )
  122.     // activate the GET for reading
  123.     get:SetFocus()
  124.  
  125.     DO WHILE ( get:exitState == GE_NOEXIT )
  126.       // check for initial typeout (no editable positions)
  127.       IF ( get:typeOut )
  128.         get:exitState := GE_ENTER
  129.       ENDIF
  130.  
  131.       // apply keystrokes until exit
  132.       DO WHILE ( get:exitState == GE_NOEXIT )
  133.         nKey := InKey(0)
  134.         GetApplyKey(get, nKey)
  135.         Eval(b, Get)
  136.       ENDDO
  137.  
  138.       // disallow exit if the VALID condition is not satisfied
  139.       IF ( !GetPostValidate(get) )
  140.         get:exitState := GE_NOEXIT
  141.       ENDIF
  142.     ENDDO
  143.  
  144.     // de-activate the GET
  145.     get:KillFocus()
  146.   ENDIF
  147.  
  148. RETURN
  149.  
  150.  
  151. FUNCTION TBDisplay(oTbr)
  152.  
  153. LOCAL nSaveRow, nSaveCol
  154. LOCAL nSaveCurs
  155.  
  156.   nSaveRow := Row()
  157.   nSaveCol := Col()
  158.  
  159.   nSaveCurs := SetCursor(SC_NONE)
  160.   
  161.   oTbr:goTop()
  162.   oTbr:refreshAll()
  163.   FullStabilize(oTbr)
  164.  
  165.   SetCursor(nSaveCurs)
  166.   @ nSaveRow, nSaveCol SAY ""
  167.  
  168. RETURN NIL
  169.  
  170.  
  171. FUNCTION TBForWhile(bFirst, bLast, bFor, bWhile)
  172.  
  173. LOCAL oTbr := TBrowseNew()
  174.  
  175.   oTbr:goTopBlock    := {||  TBFwFirst(bFirst, bWhile, bFor) }
  176.   oTbr:goBottomBlock := {||  TBFwLast(bLast, bWhile, bFor) }
  177.   oTbr:skipBlock     := {|n| TBFwSkip(n, bWhile, bFor) }
  178.  
  179.   oTbr:headSep := DEF_HSEP
  180.   oTbr:footSep := DEF_FSEP
  181.   oTbr:colSep  := DEF_CSEP
  182.  
  183. RETURN oTbr
  184.  
  185.  
  186. FUNCTION TBFwFirst(bGoFirst, bWhile, bFor)
  187.  
  188.   eval(bGoFirst)
  189.   DO WHILE !eof() .AND. eval(bWhile) .AND. !eval(bFor)
  190.     SKIP
  191.   ENDDO
  192.  
  193.   IF !eval(bWhile)
  194.     // no records match filter - could also be at eof already here
  195.     GOTO 0
  196.   ENDIF
  197.  
  198. RETURN NIL
  199.  
  200.  
  201. FUNCTION TBFwLast(bGoLast, bWhile, bFor)
  202.  
  203.   eval(bGoLast)
  204.   DO WHILE !bof() .AND. eval(bWhile) .AND. !eval(bFor)
  205.     SKIP -1
  206.   ENDDO
  207.  
  208.   IF bof() .OR. !eval(bWhile)
  209.     // No records match scope
  210.     GOTO 0
  211.   ENDIF
  212.  
  213. RETURN NIL
  214.  
  215.  
  216. FUNCTION TBFwSkip(nToSkip, bWhile, bFor)
  217.  
  218. LOCAL nSkipped := 0, ;
  219.       nLastValidRecNum := Recno()
  220.  
  221.   IF nToSkip = 0
  222.     SKIP 0
  223.     RETURN 0
  224.   ENDIF
  225.  
  226.   IF nToSkip > 0
  227.     DO WHILE nSkipped < nToSkip .AND. !eof() .AND. eval(bWhile)
  228.       SKIP
  229.       // Note the last clause here makes a big speed difference
  230.       DO WHILE !eval(bFor) .AND. !eof() .AND. eval(bWhile)
  231.         SKIP
  232.       ENDDO
  233.       IF Eval(bWhile) .AND. !eof()
  234.         // Found a new record matching the scope
  235.         nSkipped++
  236.         nLastValidRecNum := Recno()
  237.       ENDIF
  238.     ENDDO
  239.  
  240.     IF eof() .OR. !eval(bWhile)
  241.       GOTO nLastValidRecNum
  242.     ENDIF
  243.   ELSE
  244.     DO WHILE nSkipped > nToSkip .AND. !bof() .AND. eval(bWhile)
  245.       SKIP -1
  246.       // Note the last clause here makes a big speed difference
  247.       DO WHILE !eval(bFor) .AND. !bof() .AND. eval(bWhile)
  248.         SKIP -1
  249.       ENDDO
  250.       IF Eval(bWhile) .AND. !bof()
  251.         nSkipped--
  252.         nLastValidRecNum := Recno()
  253.       ENDIF
  254.     ENDDO
  255.     IF !eval(bWhile) .OR. bof()
  256.       GOTO nLastValidRecNum
  257.     ENDIF
  258.   ENDIF
  259.  
  260. RETURN nSkipped
  261.  
  262.  
  263.     FUNCTION FullStabilize(oTbr)
  264.  
  265.       DO WHILE !oTbr:stabilize()
  266.       ENDDO
  267.  
  268.     RETURN NIL
  269.