home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / FILLTB / FILLTB.PRG
Text File  |  1993-06-04  |  9KB  |  324 lines
  1. /*
  2.  ┌──────────────────────────────────────────────────────────────────────────┐
  3.  │ This is a copy of the ft_filltb() function as originally submitted for   │
  4.  │ inclusion in the Nanforum Toolkit.                                       │
  5.  │                                                                          │
  6.  │ To test the function, compile, link and run as follows (note that        │
  7.  │ "FT_TEST" must be upper case:                                            │
  8.  │                                                                          │
  9.  │   clipper filltb /n /dFT_TEST                                            │
  10.  │   rtlink fi filltb                                                       │
  11.  │   filltb                                                                 │
  12.  │                                                                          │
  13.  │ Recompile without the "/dFT_TEST" when you're ready to link it into your │
  14.  │ program.                                                                 │
  15.  └──────────────────────────────────────────────────────────────────────────┘
  16. */
  17.  
  18.  
  19. /*
  20.  * File......: FILLTB.PRG
  21.  * Author....: Todd C. MacDonald
  22.  * CIS ID....: 73767,2242
  23.  * Date......: $Date$
  24.  * Revision..: $Revision$
  25.  * Log file..: $Logfile$
  26.  *
  27.  * This is an original work by Todd C. MacDonald and is hereby placed in the
  28.  * public domain.
  29.  *
  30.  * Very special thanks to Shane Hall for certain optimization suggestions and
  31.  * the hitTop/hitBottom mods.
  32.  *
  33.  * Thanks to Rick Duke for pointing out the "sticky" cursor problem.
  34.  *
  35.  * Modification history:
  36.  * ---------------------
  37.  *
  38.  * $Log$
  39.  *
  40.  */
  41.  
  42.  
  43. /*  $DOC$
  44.  *  $FUNCNAME$
  45.  *      ft_filltb()
  46.  *  $CATEGORY$
  47.  *      To be assigned
  48.  *  $ONELINER$
  49.  *      Fill blank rows in tbrowse display keeping cursor on cur rec
  50.  *  $SYNTAX$
  51.  *      ft_filltb( <oBrowse> ) --> NIL
  52.  *  $ARGUMENTS$
  53.  *      <oBrowse> is a variable referencing a tbrowse object.
  54.  *  $RETURNS$
  55.  *      NIL
  56.  *  $DESCRIPTION$
  57.  *      This function forces all data rows in a tbrowse display to be filled
  58.  *      with data (provided enough is available in the data source).  The
  59.  *      browse cursor will stay with the current record even if the record's
  60.  *      row position changes.
  61.  *
  62.  *      This is useful for those instances where you reposition the record
  63.  *      pointer (via SEEK or whatever) and, because there aren't enough data
  64.  *      elements subsequent to the current one, the bottom part of the
  65.  *      tbrowse display is left blank.
  66.  *  $EXAMPLES$
  67.  *      // The nextkey() check and dispbegin/end() were not made internal to
  68.  *      // the function so that you could have complete control over their
  69.  *      // use.  The express purpose of the function is to fill the tbrowse
  70.  *      // display, therefore these items are left to your discretion.  If
  71.  *      // you *always* desire this behavior, you can simply create a
  72.  *      // preprocessor command that does the same thing.
  73.  *
  74.  *      IF nextkey() = 0
  75.  *
  76.  *        dispbegin()
  77.  *        ft_filltb( oBrowse )
  78.  *        dispend()
  79.  *
  80.  *      ENDIF
  81.  *  $SEEALSO$
  82.  *
  83.  *  $INCLUDE$
  84.  *
  85.  *  $END$
  86.  */
  87.  
  88.  
  89. #ifdef FT_TEST
  90.  
  91.  
  92. #include "box.ch"
  93. #include "setcurs.ch"
  94.  
  95. #define BROW_T  1
  96. #define BROW_L  2
  97. #define BROW_B  BROW_T + 12
  98. #define BROW_R  BROW_L + 15
  99.  
  100. #define MSG_T  BROW_B - 1
  101. #define MSG_L  BROW_R + 3
  102. #define MSG_B  MSG_T + 8
  103. #define MSG_R  MSG_L + 45
  104.  
  105. #define CRLF  chr( 13 ) + chr( 10 )
  106.  
  107.  
  108. STATIC aFruits := { ;
  109.   ' Apples       ', ;
  110.   ' Bananas      ', ;
  111.   ' Blueberries  ', ;
  112.   ' Cantaloupes  ', ;
  113.   ' Cherries     ', ;
  114.   ' Dates        ', ;
  115.   ' Grapes       ', ;
  116.   ' Mangos       ', ;
  117.   ' Oranges      ', ;
  118.   ' Peaches      ', ;
  119.   ' Pears        ', ;
  120.   ' Pineapples   ', ;
  121.   ' Plums        ', ;
  122.   ' Raspberries  ', ;
  123.   ' Strawberries ', ;
  124.   ' Watermelons  ' }
  125.  
  126. STATIC nPos := 1
  127.  
  128.  
  129. //--------------------------------------------------------------------------//
  130.   FUNCTION TestDriver
  131. //--------------------------------------------------------------------------//
  132.  
  133. LOCAL nSavCrs := setcursor( SC_NONE )
  134. LOCAL oBrowse := tbrowsenew( BROW_T + 1, BROW_L + 1, BROW_B - 1, BROW_R - 1 )
  135.  
  136. oBrowse:goTopBlock    := { || nPos := 1 }
  137. oBrowse:goBottomBlock := { || nPos := len( aFruits ) }
  138. oBrowse:skipBlock     := { | n | Skipper( n ) }
  139.  
  140. oBrowse:addColumn( tbcolumnnew( '', { || aFruits[ nPos ] } ) )
  141.  
  142. scroll()
  143.  
  144. @ BROW_T, BROW_L, BROW_B, BROW_R box B_SINGLE
  145.  
  146. WHILE !oBrowse:stabilize(); END
  147.  
  148. PopMsg( 'Press [Esc] to exhibit the problem...' )
  149.  
  150. nPos := 11
  151.  
  152. oBrowse:refreshAll()
  153.  
  154. WHILE !oBrowse:stabilize(); END
  155.  
  156. PopMsg( 'Notice that the pointer was repositioned and, because there ' + ;
  157.   "aren't enough subsequent data elements, the bottom of the display is " + ;
  158.   'left blank.' + CRLF + CRLF + 'Press [Esc] to execute ft_filltb()...' )
  159.  
  160. dispbegin()
  161. ft_filltb( oBrowse )
  162. dispend()
  163.  
  164. PopMsg( "There, that's much more aesthetically pleasing.  Notice that " + ;
  165.   'the display is now filled and that the cursor stayed with the record ' + ;
  166.   'it was on prior to calling ft_filltb().' + CRLF + CRLF + ;
  167.   'Press [Esc] to return to DOS...' )
  168.  
  169. cls
  170.  
  171. setcursor( nSavCrs )
  172.  
  173. RETURN nil
  174. //--------------------------------------------------------------------------//
  175.  
  176.  
  177. //--------------------------------------------------------------------------//
  178.   STATIC FUNCTION Skipper( n )
  179. //--------------------------------------------------------------------------//
  180.  
  181. LOCAL nSkipped  := 0
  182. LOCAL nFruitCnt := len( aFruits )
  183.  
  184. IF n > 0
  185.  
  186.   WHILE nPos < nFruitCnt .and. n > 0
  187.  
  188.     ++nPos
  189.     ++nSkipped
  190.     --n
  191.  
  192.   END
  193.  
  194. ELSE
  195.  
  196.   WHILE nPos > 1 .and. n < 0
  197.  
  198.     --nPos
  199.     --nSkipped
  200.     ++n
  201.  
  202.   END
  203.  
  204. ENDIF
  205.  
  206. RETURN nSkipped
  207. //--------------------------------------------------------------------------//
  208.  
  209.  
  210. //--------------------------------------------------------------------------//
  211.   STATIC FUNCTION PopMsg( c )
  212. //--------------------------------------------------------------------------//
  213.  
  214. @ MSG_T, MSG_L, MSG_B, MSG_R box B_SINGLE
  215.  
  216. clear typeahead
  217.  
  218. memoedit( c, MSG_T + 1, MSG_L + 2, MSG_B - 1, MSG_R - 1, .f. )
  219.  
  220. @ MSG_T, MSG_L, MSG_B, MSG_R box space( 9 )
  221.  
  222. RETURN nil
  223. //--------------------------------------------------------------------------//
  224.  
  225.  
  226. #endif
  227.  
  228.  
  229. //--------------------------------------------------------------------------//
  230.   FUNCTION ft_filltb( oBrowse )
  231. //--------------------------------------------------------------------------//
  232.  
  233. LOCAL lSavAutoL := oBrowse:autoLite // saves autoLite status
  234. LOCAL nMoved    := 0                // keeps track of where original record is
  235.  
  236. LOCAL nScroll     // number of records to scroll up
  237. LOCAL n           // loop counter
  238. LOCAL lSavHitTop  // oBrowse:hitTop status following initial stabilize
  239. LOCAL lSavHitBot  // oBrowse:hitBottom status following initial stabilize
  240.  
  241. // turn off hilite to prevent "sticky" cursor and speed up stabilization.
  242. oBrowse:autoLite := .f.
  243. oBrowse:deHilite()
  244.  
  245. WHILE !oBrowse:stabilize(); END
  246.  
  247. // save the state of HitTop and HitBottom from the previous stabilize as it
  248. // will be reset by filling the browse
  249. lSavHitTop := oBrowse:hitTop
  250. lSavHitBot := oBrowse:hitBottom
  251.  
  252. // try to move the pointer to the bottom row of the display
  253. WHILE oBrowse:rowPos < oBrowse:rowCount .and. !oBrowse:hitBottom
  254.  
  255.   oBrowse:down()
  256.  
  257.   WHILE !oBrowse:stabilize(); END
  258.  
  259.   nMoved++
  260.  
  261. END
  262.  
  263. // if we hit bottom, then there are 1 or more blank rows
  264. IF oBrowse:hitBottom
  265.  
  266.   // calculate number of records to scroll up past the top row
  267.   nScroll := oBrowse:rowCount - oBrowse:rowPos
  268.  
  269.   // keep track of where the original record is
  270.   nMoved -= oBrowse:rowPos
  271.  
  272.   // go to the top row
  273.   oBrowse:rowPos := 1
  274.  
  275.   // attempt to scroll up the appropriate number of records
  276.   FOR n := 1 TO nScroll
  277.  
  278.     oBrowse:up()
  279.  
  280.     WHILE !oBrowse:stabilize(); END
  281.  
  282.     IF !oBrowse:hitTop
  283.  
  284.       nMoved--
  285.  
  286.     ELSE
  287.  
  288.       EXIT
  289.  
  290.     ENDIF
  291.  
  292.   NEXT
  293.  
  294.   // put pointer back on original record
  295.   FOR n := 1 TO -nMoved
  296.  
  297.     oBrowse:down()
  298.  
  299.   NEXT
  300.  
  301. ELSE  // we didn't hit bottom so the display is already filled
  302.  
  303.   // put pointer back on original record
  304.   FOR n := 1 TO nMoved
  305.  
  306.     oBrowse:up()
  307.  
  308.   NEXT
  309.  
  310. ENDIF
  311.  
  312. WHILE !oBrowse:stabilize(); END
  313.  
  314. // turn hilite on and restore autoLite status
  315. oBrowse:hilite()
  316. oBrowse:autoLite := lSavAutoL
  317.  
  318. // restore hitTop and hitBottom status
  319. oBrowse:hitTop    := lSavHitTop
  320. oBrowse:hitBottom := lSavHitBot
  321.  
  322. RETURN nil
  323. //--------------------------------------------------------------------------//
  324.