home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBLIB.EXE / TBUTILS.PRG < prev    next >
Encoding:
Text File  |  1992-03-09  |  19.8 KB  |  760 lines
  1. // Tbutils.prg
  2. //
  3. // Utility routines for TBrowse and TBColumn classes
  4. //
  5. // Export:
  6. //   MyTBColumnNew    - Create TBColumn object, allows setting of all i vars
  7. //   MyTBrowseNew     - Same for TBrowse object
  8. //   TBCClone         - Return a clone of an existing TBColumn object
  9. //   TBClone          - Return a clone of an existing TBrowse  object
  10. //   TBMsg            - Display a message at maxrow() without side-effect
  11. //   FullStabilize    - Repeatedly call stabilize until it returns .T.
  12. //   KeyStabilize     - Repeatedly call stabilize until it returns .T.
  13. //                      OR the user presses a key. Returns .T. if stabilized,
  14. //                      .F. if key pressed. Does not remove key from buffer
  15. //   StdMeth          - Simple routine performing the defuaklt mapping of
  16. //                      keys to methods
  17. //   NumVisibleRows   - Returns number of visible data rows
  18. //
  19. //   TBCColPos        - Returns array containing column position of
  20. //                      each visible column
  21. //   TBWhSkip         - SkipBlock function implementing general purpose
  22. //                      while condition
  23. //   TBWhStart        - goTopBlock function implementing general purpose
  24. //                      while condition
  25. //   TBWhEnd          - goBottomBlock function implementing general
  26. //                      purpose while condition
  27. //   TBForStart       - GoTopBlock function implementing general purpose
  28. //                      for condition
  29. //   TBForEnd         - GoBottomBlock function implementing general
  30. //                      purpose for condition
  31. //   TBForSkip        - SkipBlock function implementing general purpose
  32. //                      for condition
  33. //   TBFwFirst        - goTopBlock function implementing general purpose
  34. //                      for and while condition
  35. //   TBFwLast         - goBottomBlock function implementing general
  36. //                      purpose for and while condition
  37. //   TBFwSkip         - skipBlock function implementing general
  38. //                      purpose for and while condition
  39. //   AddAllFields     - Add all fields in current database as TBColumns
  40. //                      to the passed TBrowse object
  41. //   DbSkipBlock      - Abstracted skipblock for database browsing
  42. //   DbStabilize      - Repeatedly call stabilize until it returns .T.,
  43. //                      ensuring the same record is highlighted (for
  44. //                      database edits)
  45. //   TBForWhile       - Return TBrowse object implementing for and
  46. //                      while conditions. Pass as blocks.
  47. //   TBFwGoNext       - Move to next record with for and while condition
  48. //                      set. Return .T. if moved, otherwise .F.
  49. //   TBFwGoPrev       - Move to previous record with for and while
  50. //                      condition set. Return .T. if moved, otherwise .F.
  51. //   TBaGoLast        - Go to last     record supporting append mode
  52. //   TBaGoFirst       - Go to first    record supporting append mode
  53. //   TBaGoNext        - Go to next     record supporting append mode
  54. //   TBaGoPrev        - Go to previous record supporting append mode
  55. //   TBfwaFirst       - TBrowse routine called by goTopBlock. fwa stands for
  56. //                      "for/while/append". It supports generic for and while
  57. //                      conditions and append mode.
  58. //   TBfwaLast        - Routine called by goBottomBlock to move to the last
  59. //                      record in the database matching the for and while
  60. //                      condition, and taking append mode into account.
  61. //   TBfwaGoNext      - Move to next record supporting for and while
  62. //                      conditions and append mode
  63. //   TBfwaGoPrev      - Move to previous record record supporting for and
  64. //                      while conditions and append mode
  65. //   TBfwaBrowse      - Sets up TBrowse object for a browse with a while
  66. //                      and for condition and append mode
  67.  
  68. // Compile with /a /m /n /w
  69.  
  70.     #include "inkey.ch"
  71.     #include "Tbutils.ch"
  72.  
  73.     #define SET_IVAR(iVar, p) iVar := iif(p != NIL, p, iVar)
  74.  
  75.     FUNCTION MyTBColumnNew(bBlock, cargo, bColorBlock, cColSep, ;
  76.                             aDefColor, cFooting, cFootSep, cHeading, ;
  77.                             cHeadSep, nWidth)
  78.  
  79.     LOCAL oTbc := TBColumnNew()
  80.  
  81.       SET_IVAR(oTbc:block,      bBlock)
  82.       SET_IVAR(oTbc:cargo,      cargo)
  83.       SET_IVAR(oTbc:colorBlock, bColorBlock)
  84.       SET_IVAR(oTbc:colSep,     cColSep)
  85.       SET_IVAR(oTbc:defColor,   aDefColor)
  86.       SET_IVAR(oTbc:footing,    cFooting)
  87.       SET_IVAR(oTbc:footSep,    cFootsep)
  88.       SET_IVAR(oTbc:heading,    cHeading)
  89.       SET_IVAR(oTbc:headSep,    cHeadSep)
  90.       SET_IVAR(oTbc:width,      nWidth)
  91.  
  92.     RETURN oTbc
  93.  
  94.  
  95.     FUNCTION MyTBrowseNew(lAutoLite, cargo, cColorSpec, nColPos,      ;
  96.                           cColSep, cFootSep, nFreeze, bGoBottomBlock, ;
  97.                           bGoTopBlock, cHeadSep, lHitBottom, lHitTop, ;
  98.                           nBottom, nLeft, nRight, nTop, nRowPos,      ;
  99.                           bSkipBlock, lStable)
  100.  
  101.     LOCAL oTbr := TBrowseNew()
  102.  
  103.       SET_IVAR(oTbr:autoLite,      lAutoLite)
  104.       SET_IVAR(oTbr:cargo,         cargo)
  105.       SET_IVAR(oTbr:colorSpec,     cColorSpec)
  106.       SET_IVAR(oTbr:colPos,        nColPos)
  107.       SET_IVAR(oTbr:colSep,        cColSep)
  108.       SET_IVAR(oTbr:footSep,       cFootSep)
  109.       SET_IVAR(oTbr:freeze,        nFreeze)
  110.       SET_IVAR(oTbr:goBottomBlock, bGoBottomBlock)
  111.       SET_IVAR(oTbr:goTopBlock,    bGoTopBlock)
  112.       SET_IVAR(oTbr:headSep,       cHeadSep)
  113.       SET_IVAR(oTbr:hitBottom,     lHitBottom)
  114.       SET_IVAR(oTbr:hitTop,        lHitTop)
  115.       SET_IVAR(oTbr:nBottom,       nBottom)
  116.       SET_IVAR(oTbr:nLeft,         nLeft)
  117.       SET_IVAR(oTbr:nRight,        nRight)
  118.       SET_IVAR(oTbr:nTop,          nTop)
  119.       SET_IVAR(oTbr:rowPos,        nRowPos)
  120.       SET_IVAR(oTbr:skipBlock,     bSkipBlock)
  121.       SET_IVAR(oTbr:stable,        lStable)
  122.  
  123.     RETURN oTbr
  124.  
  125.  
  126.     FUNCTION TBClone(oTbcOld)
  127.  
  128.     LOCAL oTbcNew := TBColumnNew()
  129.  
  130.       oTbcNew:block      := oTbcOld:block
  131.       oTbcNew:cargo      := oTbcOld:cargo
  132.       oTbcNew:colorBlock := oTbcOld:colorBlock
  133.       oTbcNew:defColor   := oTbcOld:defColor
  134.       oTbcNew:footing    := oTbcOld:footing
  135.       oTbcNew:footSep    := oTbcOld:footSep
  136.       oTbcNew:heading    := oTbcOld:heading
  137.       oTbcNew:headSep    := oTbcOld:headSep
  138.       oTbcNew:width      := oTbcOld:width
  139.  
  140.     RETURN oTbcNew
  141.  
  142.  
  143.     FUNCTION TBRClone(oTbrOld)
  144.  
  145.     LOCAL oTbrNew := TBrowseNew()
  146.  
  147.       oTbrNew:autoLite      := oTbrOld:autoLite
  148.       oTbrNew:cargo         := oTbrOld:cargo
  149.       oTbrNew:colorSpec     := oTbrOld:colorSpec
  150.       oTbrNew:colPos        := oTbrOld:colPos
  151.       oTbrNew:footSep       := oTbrOld:footSep
  152.       oTbrNew:freeze        := oTbrOld:freeze
  153.       oTbrNew:goBottomBlock := oTbrOld:goBottomBlock
  154.       oTbrNew:goTopBlock    := oTbrOld:goTopBlock
  155.       oTbrNew:headSep       := oTbrOld:headSep
  156.       oTbrNew:hitBottom     := oTbrOld:hitBottom
  157.       oTbrNew:hitTop        := oTbrOld:hitTop
  158.       oTbrNew:nBottom       := oTbrOld:nBottom
  159.       oTbrNew:nLeft         := oTbrOld:nLeft
  160.       oTbrNew:nRight        := oTbrOld:nRight
  161.       oTbrNew:nTop          := oTbrOld:nTop
  162.       oTbrNew:rowPos        := oTbrOld:rowPos
  163.       oTbrNew:skipBlock     := oTbrOld:skipBlock
  164.       oTbrNew:stable        := oTbrOld:stable
  165.  
  166.     RETURN oTbrNew
  167.  
  168.  
  169.     FUNCTION TBMsg(c)
  170.  
  171.     LOCAL cSs := saveScreen(maxRow(), 0, maxRow(), maxCol())
  172.  
  173.       @ maxRow(), 0
  174.       @ maxRow(), 0 SAY c
  175.       inkey(0)
  176.  
  177.       restScreen(maxRow(), 0, maxRow(), maxCol(), cSs)
  178.  
  179.     RETURN NIL
  180.  
  181.  
  182.     FUNCTION StdMeth(nKey, oTbr)
  183.  
  184.     LOCAL lKeyHandled := .T.
  185.  
  186.       DO CASE
  187.         CASE nKey == K_DOWN;       oTbr:down()
  188.         CASE nKey == K_UP;         oTbr:up()
  189.         CASE nKey == K_PGDN;       oTbr:pageDown()
  190.         CASE nKey == K_PGUP;       oTbr:pageUp()
  191.         CASE nKey == K_CTRL_PGUP;  oTbr:goTop()
  192.         CASE nKey == K_CTRL_PGDN;  oTbr:goBottom()
  193.         CASE nKey == K_RIGHT;      oTbr:right()
  194.         CASE nKey == K_LEFT;       oTbr:left()
  195.         CASE nKey == K_HOME;       oTbr:home()
  196.         CASE nKey == K_END;        oTbr:end()
  197.         CASE nKey == K_CTRL_LEFT;  oTbr:panLeft()
  198.         CASE nKey == K_CTRL_RIGHT; oTbr:panRight()
  199.         CASE nKey == K_CTRL_HOME;  oTbr:panHome()
  200.         CASE nKey == K_CTRL_END;   oTbr:panEnd()
  201.         OTHERWISE;                 lKeyHandled := .F.
  202.       ENDCASE
  203.  
  204.     RETURN lKeyHandled
  205.  
  206.  
  207.     FUNCTION NumVisibleRows(oTbr)
  208.  
  209.     LOCAL nSaveRowPos := oTbr:rowPos
  210.     LOCAL nLastVisible
  211.  
  212.       dispBegin()
  213.       oTbr:deHilite()
  214.  
  215.       oTbr:rowPos := oTbr:rowCount
  216.       DO WHILE !oTbr:stabilize()
  217.       ENDDO
  218.  
  219.       nLastVisible := oTbr:rowPos
  220.  
  221.       oTbr:deHilite()
  222.  
  223.       oTbr:rowPos := nSaveRowPos
  224.       DO WHILE !oTbr:stabilize()
  225.       ENDDO
  226.  
  227.       dispEnd()
  228.  
  229.     RETURN nlastVisible
  230.  
  231.  
  232.     FUNCTION TBCColPos(oTbr)
  233.  
  234.     LOCAL nSaveColNum := oTbr:colPos
  235.     LOCAL aColPos := array(oTbr:rightVisible)
  236.     LOCAL nColNum
  237.  
  238.       dispBegin()
  239.       FOR nColNum := oTbr:leftVisible TO oTbr:rightVisible
  240.         oTbr:colPos := nColNum
  241.         DO WHILE !oTbr:stabilize()
  242.         ENDDO
  243.         aColPos[nColNum] := col()
  244.         oTbr:deHilite()
  245.       NEXT
  246.  
  247.       // redisplay current prompt
  248.       oTbr:colPos := nSaveColNum
  249.       DO WHILE !oTbr:stabilize()
  250.       ENDDO
  251.  
  252.       dispEnd()
  253.  
  254.     RETURN aColPos
  255.  
  256.  
  257.     FUNCTION TBForStart(bFor)
  258.     
  259.       GOTO TOP
  260.       DO WHILE !eof() .AND. !eval(bFor)
  261.         SKIP
  262.       ENDDO
  263.     
  264.       // Already at eof() if !eval(bFor)
  265.     
  266.     RETURN NIL
  267.     
  268.     
  269.     FUNCTION TBForEnd(bFor)
  270.     
  271.       GOTO BOTTOM
  272.       DO WHILE !bof() .AND. !eval(bFor)
  273.         SKIP -1
  274.       ENDDO
  275.  
  276.       IF bof()
  277.         // no records match filter
  278.         GOTO 0
  279.       ENDIF
  280.     
  281.     RETURN NIL
  282.     
  283.  
  284.     FUNCTION TBForSkip(nToSkip, bFor)
  285.  
  286.     FIELD Lname IN TbDbf1
  287.     LOCAL nSkipped := 0, ;
  288.           nLastValidRecNum := Recno()
  289.  
  290.       IF nToSkip == 0
  291.         SKIP 0
  292.         RETURN 0
  293.       ENDIF
  294.  
  295.       IF nToSkip > 0
  296.         DO WHILE nSkipped < nToSkip .AND. !Eof()
  297.           SKIP
  298.           DO WHILE !eval(bFor) .AND. !Eof()
  299.             SKIP
  300.           ENDDO
  301.           IF eval(bFor)
  302.             nSkipped++
  303.             nLastValidRecNum := Recno()
  304.           ENDIF
  305.         ENDDO
  306.         IF eof()
  307.           GOTO nLastValidRecNum
  308.         ENDIF
  309.       ELSE
  310.         DO WHILE nSkipped > nToSkip .AND. !Bof()
  311.           SKIP -1
  312.           DO WHILE !eval(bFor) .AND. !Bof()
  313.             SKIP -1
  314.           ENDDO
  315.           IF eval(bFor)
  316.             nSkipped--
  317.             nLastValidRecNum := Recno()
  318.           ENDIF
  319.         ENDDO
  320.         IF Bof()
  321.           GOTO nLastValidecNum
  322.         ENDIF
  323.       ENDIF
  324.  
  325.     RETURN nSkipped
  326.  
  327.  
  328.     FUNCTION TBForWhile(bFirst, bLast, bFor, bWhile)
  329.  
  330.     LOCAL oTbr := TBrowseNew()
  331.  
  332.       oTbr:goTopBlock    := {||  TBFwFirst(bFirst, bWhile, bFor) }
  333.       oTbr:goBottomBlock := {||  TBFwLast(bLast, bWhile, bFor) }
  334.       oTbr:skipBlock     := {|n| TBFwSkip(n, bWhile, bFor) }
  335.  
  336.     RETURN oTbr
  337.  
  338.     
  339.     FUNCTION TBFwFirst(bGoFirst, bWhile, bFor)
  340.     
  341.       eval(bGoFirst)
  342.       DO WHILE !eof() .AND. eval(bWhile) .AND. !eval(bFor)
  343.         SKIP
  344.       ENDDO
  345.     
  346.       IF !eval(bWhile)
  347.         // no records match filter - could also be at eof already here
  348.         GOTO 0
  349.       ENDIF
  350.     
  351.     RETURN NIL
  352.  
  353.     
  354.     FUNCTION TBFwLast(bGoLast, bWhile, bFor)
  355.     
  356.       eval(bGoLast)
  357.       DO WHILE !bof() .AND. eval(bWhile) .AND. !eval(bFor)
  358.         SKIP -1
  359.       ENDDO
  360.     
  361.       IF bof() .OR. !eval(bWhile)
  362.         // No records match scope
  363.         GOTO 0
  364.       ENDIF
  365.     
  366.     RETURN NIL
  367.  
  368.  
  369.     FUNCTION TBFwSkip(nToSkip, bWhile, bFor)
  370.     
  371.     LOCAL nSkipped := 0, ;
  372.           nLastValidRecNum := Recno()
  373.  
  374.       IF nToSkip = 0
  375.         SKIP 0
  376.         RETURN 0
  377.       ENDIF
  378.  
  379.       IF nToSkip > 0
  380.         DO WHILE nSkipped < nToSkip .AND. !eof() .AND. eval(bWhile)
  381.           SKIP
  382.           // Note the last clause here makes a big speed difference
  383.           DO WHILE !eval(bFor) .AND. !eof() .AND. eval(bWhile)
  384.             SKIP
  385.           ENDDO
  386.           IF Eval(bWhile) .AND. !eof()
  387.             // Found a new record matching the scope
  388.             nSkipped++
  389.             nLastValidRecNum := Recno()
  390.           ENDIF
  391.         ENDDO
  392.     
  393.         IF eof() .OR. !eval(bWhile)
  394.           GOTO nLastValidRecNum
  395.         ENDIF
  396.       ELSE
  397.         DO WHILE nSkipped > nToSkip .AND. !bof() .AND. eval(bWhile)
  398.           SKIP -1
  399.           // Note the last clause here makes a big speed difference
  400.           DO WHILE !eval(bFor) .AND. !bof() .AND. eval(bWhile)
  401.             SKIP -1
  402.           ENDDO
  403.           IF Eval(bWhile) .AND. !bof()
  404.             nSkipped--
  405.             nLastValidRecNum := Recno()
  406.           ENDIF
  407.         ENDDO
  408.         IF !eval(bWhile) .OR. bof()
  409.           GOTO nLastValidRecNum
  410.         ENDIF
  411.       ENDIF
  412.  
  413.     RETURN nSkipped
  414.  
  415.  
  416.  
  417.     FUNCTION AddAllFields(oTbr)
  418.     
  419.     LOCAL oTbc, ;
  420.           nFieldNum, ;
  421.           nFields := fcount()
  422.     
  423.       FOR nFieldNum := 1 TO nFields
  424.         IF valtype(fieldget(nFieldNum)) == "M"
  425.           oTbc := TBColumnNew(field(nFieldNum), ;
  426.                               MemoBlock(nFieldNum))
  427.         ELSE
  428.           oTbc := TBColumnNew(field(nFieldNum), fieldblock(field(nFieldNum)))
  429.         ENDIF
  430.         oTbr:addColumn(oTbc)
  431.       NEXT
  432.     
  433.     RETURN NIL
  434.  
  435.     FUNCTION MemoBlock(nFieldNum)
  436.  
  437.     RETURN {|nMode| iif(nMode == NIL, ;
  438.                         "Memo", ;
  439.                         fieldblock(field(nFieldNum))) }
  440.  
  441.  
  442.     FUNCTION DbSkipBlock(n, bNext, bPrev)
  443.  
  444.     LOCAL nSkipped := 0
  445.  
  446.       // Idiosyncrasy for database skipper
  447.       IF n = 0
  448.         SKIP 0
  449.       ELSEIF n > 0
  450.         DO WHILE nSkipped != n .AND. eval(bNext)
  451.           nSkipped++
  452.         ENDDO
  453.       ELSE
  454.         DO WHILE nSkipped != n .AND. eval(bPrev)
  455.           nSkipped--
  456.         ENDDO
  457.       ENDIF
  458.  
  459.     RETURN nSkipped
  460.  
  461.  
  462.     // Repeatedly call TBrowse:stabilize() until it returns .T.
  463.  
  464.     FUNCTION FullStabilize(oTbr)
  465.  
  466.       DO WHILE !oTbr:stabilize()
  467.       ENDDO
  468.  
  469.     RETURN NIL
  470.  
  471.  
  472.     // Repeatedly call TBrowse:stabilize() until it returns .T. OR the
  473.     // user presses a key. Returns .T. if stabilized otherwise .F.
  474.  
  475.     FUNCTION KeyStabilize(oTbr)
  476.  
  477.       DO WHILE NextKey() == 0 .AND. !oTbr:stabilize()
  478.       ENDDO
  479.  
  480.     RETURN oTbr:stable
  481.  
  482.  
  483.     // Repeatedly call stabilize until it returns .T., ensuring the same
  484.     // record is highlighted (for database edits)
  485.  
  486.     FUNCTION DbStabilize(oTbr)
  487.  
  488.     LOCAL nSaveRecno := recno()
  489.  
  490.       oTbr:refreshAll()
  491.       FullStabilize(oTbr)
  492.  
  493.       DO WHILE recno() != nSaveRecno
  494.         oTbr:up()
  495.         FullStabilize(oTbr)
  496.       ENDDO
  497.  
  498.     RETURN NIL
  499.  
  500.  
  501.     // Tbrowse routine called by goTopBlock. fwa stands for
  502.     // "for/while/append". It supports generic for and while
  503.     // conditions and append mode.
  504.  
  505.     FUNCTION TBfwaFirst(bGoFirst, bWhile, bFor)
  506.     
  507.       eval(bGoFirst)
  508.       DO WHILE !eof() .AND. eval(bWhile) .AND. !eval(bFor)
  509.         SKIP
  510.       ENDDO
  511.  
  512.       IF eof() .OR. !eval(bWhile)
  513.         GOTO 0
  514.       ENDIF
  515.     
  516.     RETURN NIL
  517.  
  518.  
  519.     // Routine called by goBottomBlock to move to the last record
  520.     // in the database matching the for and while condition, and
  521.     // taking append mode into account.
  522.  
  523.     FUNCTION TBfwaLast(bGoLast, bWhile, bFor, lAppend)
  524.     
  525.       IF lAppend
  526.         GOTO 0
  527.       ELSE
  528.         eval(bGoLast)
  529.         DO WHILE !bof() .AND. eval(bWhile) .AND. !eval(bFor)
  530.           SKIP -1
  531.         ENDDO
  532.     
  533.         IF bof() .OR. !eval(bWhile)
  534.           GOTO 0
  535.         ENDIF
  536.       ENDIF
  537.  
  538.     RETURN NIL
  539.  
  540.  
  541.     // Move to next record supporting for and while conditions
  542.     // and append mode
  543.  
  544.     FUNCTION TBfwaGoNext(bFor, bWhile, lAppend)
  545.  
  546.     LOCAL nSaveRecNum := recno()
  547.     LOCAL lMoved := .T.
  548.  
  549.       IF eof()
  550.         lMoved := .F.
  551.       ELSE
  552.         SKIP
  553.         DO WHILE !eval(bFor) .AND. eval(bWhile) .AND. !eof()
  554.           SKIP
  555.         ENDDO
  556.  
  557.         IF eof() .AND. lAppend
  558.           // fine ...
  559.         ELSEIF !eval(bWhile) .OR. eof()
  560.           IF !eval(bWhile) .AND. lAppend
  561.             GOTO 0
  562.           ELSE
  563.             lMoved := .F.
  564.             GOTO nSaveRecNum
  565.           ENDIF
  566.         ENDIF
  567.       ENDIF
  568.  
  569.     RETURN lMoved
  570.  
  571.  
  572.     // Move to previous record supporting for and while conditions
  573.     // and append mode
  574.  
  575.     FUNCTION TBfwaGoPrev(bFor, bWhile, bLast)
  576.  
  577.     LOCAL nSaveRecNum := recno()
  578.     LOCAL lMoved := .T.
  579.  
  580.       // Take special care at eof() - a SKIP -1 is not sufficient
  581.       // because of the filters
  582.       IF eof()
  583.         eval(bLast)
  584.       ELSE
  585.         SKIP -1
  586.       ENDIF
  587.  
  588.       DO WHILE !eval(bFor) .AND. eval(bWhile) .AND. !bof()
  589.         SKIP -1
  590.       ENDDO
  591.  
  592.       IF !eval(bWhile) .OR. bof()
  593.         GOTO nSaveRecNum
  594.         lMoved := .F.
  595.       ENDIF
  596.  
  597.     RETURN lMoved
  598.  
  599.  
  600.     // Creates and returns a TBrowse object for a browse with a while
  601.     // and for condition and append mode
  602.  
  603.     FUNCTION TBfwaBrowse(bWhile, bFor, bFirst, bLast)
  604.  
  605.     LOCAL oTbr  := TBrowseNew()
  606.     LOCAL bNext := {|| TBfwaGoNext(bFor, bWhile, APPEND_MODE(oTbr)) }
  607.     LOCAL bPrev := {|| TBfwaGoPrev(bFor, bWhile, bLast) }
  608.  
  609.       oTbr:cargo := DictNew()
  610.       APPEND_MODE(oTbr, .F.)
  611.  
  612.       oTbr:goTopBlock    := {||  TBfwaFirst(bFirst, bWhile, bFor) }
  613.  
  614.       oTbr:goBottomBlock := {||  TBfwaLast(bLast,  bWhile, bFor, ;
  615.                                            APPEND_MODE(oTbr))   }
  616.       oTbr:skipBlock := {|n| DbSkipBlock(n, bNext, bPrev) }
  617.  
  618.       oTbr:goTop()
  619.  
  620.     RETURN oTbr
  621.  
  622.  
  623.     FUNCTION TBWhStart(bFirst, bWhile)
  624.  
  625.       Eval(bFirst)
  626.       IF !eval(bWhile)
  627.         GOTO 0
  628.       ENDIF
  629.  
  630.     RETURN NIL
  631.  
  632.  
  633.     FUNCTION TBWhEnd(bLast,  bWhile)
  634.  
  635.       eval(bLast)
  636.       IF !eval(bWhile)
  637.         GOTO 0
  638.       ENDIF
  639.  
  640.     RETURN NIL
  641.  
  642.  
  643.     // Handles empty databases and no records matching condition
  644.  
  645.     FUNCTION TBWhSkip(nToSkip, bWhile)
  646.  
  647.     LOCAL nSkipped := 0
  648.  
  649.       IF nToSkip = 0
  650.         SKIP 0
  651.         RETURN 0
  652.       ENDIF
  653.  
  654.       IF nToSkip > 0
  655.         DO WHILE eval(bWhile) .AND. !eof() .AND. nSkipped < nToSkip
  656.           SKIP
  657.           IF eval(bWhile) .AND. !eof()
  658.             nSkipped++
  659.           ENDIF
  660.         ENDDO
  661.         IF !eval(bWhile) .OR. eof()
  662.           SKIP -1
  663.         ENDIF
  664.       ELSE
  665.         DO WHILE eval(bWhile) .AND. !bof() .AND. nSkipped > nToSkip
  666.           SKIP -1
  667.           IF eval(bWhile) .AND. !bof()
  668.             nSkipped--
  669.           ENDIF
  670.         ENDDO
  671.         IF !eval(bWhile)
  672.           SKIP
  673.         ENDIF
  674.       ENDIF
  675.  
  676.     RETURN nSkipped
  677.  
  678.  
  679.     FUNCTION TBFwGoNext(bFor, bWhile)
  680.  
  681.     LOCAL nSaveRecNum := recno()
  682.     LOCAL lMoved := .T.
  683.  
  684.       SKIP
  685.       DO WHILE !eval(bFor) .AND. eval(bWhile) .AND. !eof()
  686.         SKIP
  687.       ENDDO
  688.  
  689.       IF !eval(bWhile) .OR. eof()
  690.         GOTO nSaveRecnum
  691.         lMoved := .F.
  692.       ENDIF  
  693.  
  694.     RETURN lMoved
  695.  
  696.  
  697.     FUNCTION TBFwGoPrev(bFor, bWhile)
  698.  
  699.     LOCAL nSaveRecNum := recno()
  700.     LOCAL lMoved := .T.
  701.  
  702.       SKIP -1
  703.       DO WHILE !eval(bFor) .AND. eval(bWhile) .AND. !bof()
  704.         SKIP -1
  705.       ENDDO
  706.  
  707.       IF !eval(bWhile) .OR. bof()
  708.         GOTO nSaveRecNum
  709.         lMoved := .F.
  710.       ENDIF
  711.  
  712.     RETURN lMoved
  713.  
  714.  
  715.     FUNCTION TBaGoPrev
  716.  
  717.     LOCAL lMoved := .T.
  718.  
  719.       SKIP -1
  720.       IF bof()
  721.         lMoved := .F.
  722.       ENDIF
  723.  
  724.     RETURN lMoved
  725.  
  726.  
  727.     FUNCTION TBaGoNext(lAppend)
  728.  
  729.     LOCAL lMoved := .T.
  730.  
  731.       IF eof() .OR. LastRec() = 0
  732.         lMoved := .F.
  733.       ELSE
  734.         SKIP
  735.         IF eof() .AND. !lAppend
  736.           SKIP -1
  737.           lMoved := .F.
  738.         ENDIF
  739.       ENDIF
  740.  
  741.     RETURN lMoved
  742.  
  743.  
  744.     FUNCTION TBaGoFirst
  745.  
  746.       GOTO TOP
  747.  
  748.     RETURN NIL
  749.  
  750.     
  751.     FUNCTION TBaGoLast(lAppend)
  752.  
  753.       GOTO BOTTOM
  754.       IF lAppend
  755.         SKIP
  756.       ENDIF
  757.  
  758.     RETURN NIL
  759.  
  760.