home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
filltb.zip
/
FILLTB.PRG
Wrap
Text File
|
1993-06-04
|
9KB
|
324 lines
/*
┌──────────────────────────────────────────────────────────────────────────┐
│ This is a copy of the ft_filltb() function as originally submitted for │
│ inclusion in the Nanforum Toolkit. │
│ │
│ To test the function, compile, link and run as follows (note that │
│ "FT_TEST" must be upper case: │
│ │
│ clipper filltb /n /dFT_TEST │
│ rtlink fi filltb │
│ filltb │
│ │
│ Recompile without the "/dFT_TEST" when you're ready to link it into your │
│ program. │
└──────────────────────────────────────────────────────────────────────────┘
*/
/*
* File......: FILLTB.PRG
* Author....: Todd C. MacDonald
* CIS ID....: 73767,2242
* Date......: $Date$
* Revision..: $Revision$
* Log file..: $Logfile$
*
* This is an original work by Todd C. MacDonald and is hereby placed in the
* public domain.
*
* Very special thanks to Shane Hall for certain optimization suggestions and
* the hitTop/hitBottom mods.
*
* Thanks to Rick Duke for pointing out the "sticky" cursor problem.
*
* Modification history:
* ---------------------
*
* $Log$
*
*/
/* $DOC$
* $FUNCNAME$
* ft_filltb()
* $CATEGORY$
* To be assigned
* $ONELINER$
* Fill blank rows in tbrowse display keeping cursor on cur rec
* $SYNTAX$
* ft_filltb( <oBrowse> ) --> NIL
* $ARGUMENTS$
* <oBrowse> is a variable referencing a tbrowse object.
* $RETURNS$
* NIL
* $DESCRIPTION$
* This function forces all data rows in a tbrowse display to be filled
* with data (provided enough is available in the data source). The
* browse cursor will stay with the current record even if the record's
* row position changes.
*
* This is useful for those instances where you reposition the record
* pointer (via SEEK or whatever) and, because there aren't enough data
* elements subsequent to the current one, the bottom part of the
* tbrowse display is left blank.
* $EXAMPLES$
* // The nextkey() check and dispbegin/end() were not made internal to
* // the function so that you could have complete control over their
* // use. The express purpose of the function is to fill the tbrowse
* // display, therefore these items are left to your discretion. If
* // you *always* desire this behavior, you can simply create a
* // preprocessor command that does the same thing.
*
* IF nextkey() = 0
*
* dispbegin()
* ft_filltb( oBrowse )
* dispend()
*
* ENDIF
* $SEEALSO$
*
* $INCLUDE$
*
* $END$
*/
#ifdef FT_TEST
#include "box.ch"
#include "setcurs.ch"
#define BROW_T 1
#define BROW_L 2
#define BROW_B BROW_T + 12
#define BROW_R BROW_L + 15
#define MSG_T BROW_B - 1
#define MSG_L BROW_R + 3
#define MSG_B MSG_T + 8
#define MSG_R MSG_L + 45
#define CRLF chr( 13 ) + chr( 10 )
STATIC aFruits := { ;
' Apples ', ;
' Bananas ', ;
' Blueberries ', ;
' Cantaloupes ', ;
' Cherries ', ;
' Dates ', ;
' Grapes ', ;
' Mangos ', ;
' Oranges ', ;
' Peaches ', ;
' Pears ', ;
' Pineapples ', ;
' Plums ', ;
' Raspberries ', ;
' Strawberries ', ;
' Watermelons ' }
STATIC nPos := 1
//--------------------------------------------------------------------------//
FUNCTION TestDriver
//--------------------------------------------------------------------------//
LOCAL nSavCrs := setcursor( SC_NONE )
LOCAL oBrowse := tbrowsenew( BROW_T + 1, BROW_L + 1, BROW_B - 1, BROW_R - 1 )
oBrowse:goTopBlock := { || nPos := 1 }
oBrowse:goBottomBlock := { || nPos := len( aFruits ) }
oBrowse:skipBlock := { | n | Skipper( n ) }
oBrowse:addColumn( tbcolumnnew( '', { || aFruits[ nPos ] } ) )
scroll()
@ BROW_T, BROW_L, BROW_B, BROW_R box B_SINGLE
WHILE !oBrowse:stabilize(); END
PopMsg( 'Press [Esc] to exhibit the problem...' )
nPos := 11
oBrowse:refreshAll()
WHILE !oBrowse:stabilize(); END
PopMsg( 'Notice that the pointer was repositioned and, because there ' + ;
"aren't enough subsequent data elements, the bottom of the display is " + ;
'left blank.' + CRLF + CRLF + 'Press [Esc] to execute ft_filltb()...' )
dispbegin()
ft_filltb( oBrowse )
dispend()
PopMsg( "There, that's much more aesthetically pleasing. Notice that " + ;
'the display is now filled and that the cursor stayed with the record ' + ;
'it was on prior to calling ft_filltb().' + CRLF + CRLF + ;
'Press [Esc] to return to DOS...' )
cls
setcursor( nSavCrs )
RETURN nil
//--------------------------------------------------------------------------//
//--------------------------------------------------------------------------//
STATIC FUNCTION Skipper( n )
//--------------------------------------------------------------------------//
LOCAL nSkipped := 0
LOCAL nFruitCnt := len( aFruits )
IF n > 0
WHILE nPos < nFruitCnt .and. n > 0
++nPos
++nSkipped
--n
END
ELSE
WHILE nPos > 1 .and. n < 0
--nPos
--nSkipped
++n
END
ENDIF
RETURN nSkipped
//--------------------------------------------------------------------------//
//--------------------------------------------------------------------------//
STATIC FUNCTION PopMsg( c )
//--------------------------------------------------------------------------//
@ MSG_T, MSG_L, MSG_B, MSG_R box B_SINGLE
clear typeahead
memoedit( c, MSG_T + 1, MSG_L + 2, MSG_B - 1, MSG_R - 1, .f. )
@ MSG_T, MSG_L, MSG_B, MSG_R box space( 9 )
RETURN nil
//--------------------------------------------------------------------------//
#endif
//--------------------------------------------------------------------------//
FUNCTION ft_filltb( oBrowse )
//--------------------------------------------------------------------------//
LOCAL lSavAutoL := oBrowse:autoLite // saves autoLite status
LOCAL nMoved := 0 // keeps track of where original record is
LOCAL nScroll // number of records to scroll up
LOCAL n // loop counter
LOCAL lSavHitTop // oBrowse:hitTop status following initial stabilize
LOCAL lSavHitBot // oBrowse:hitBottom status following initial stabilize
// turn off hilite to prevent "sticky" cursor and speed up stabilization.
oBrowse:autoLite := .f.
oBrowse:deHilite()
WHILE !oBrowse:stabilize(); END
// save the state of HitTop and HitBottom from the previous stabilize as it
// will be reset by filling the browse
lSavHitTop := oBrowse:hitTop
lSavHitBot := oBrowse:hitBottom
// try to move the pointer to the bottom row of the display
WHILE oBrowse:rowPos < oBrowse:rowCount .and. !oBrowse:hitBottom
oBrowse:down()
WHILE !oBrowse:stabilize(); END
nMoved++
END
// if we hit bottom, then there are 1 or more blank rows
IF oBrowse:hitBottom
// calculate number of records to scroll up past the top row
nScroll := oBrowse:rowCount - oBrowse:rowPos
// keep track of where the original record is
nMoved -= oBrowse:rowPos
// go to the top row
oBrowse:rowPos := 1
// attempt to scroll up the appropriate number of records
FOR n := 1 TO nScroll
oBrowse:up()
WHILE !oBrowse:stabilize(); END
IF !oBrowse:hitTop
nMoved--
ELSE
EXIT
ENDIF
NEXT
// put pointer back on original record
FOR n := 1 TO -nMoved
oBrowse:down()
NEXT
ELSE // we didn't hit bottom so the display is already filled
// put pointer back on original record
FOR n := 1 TO nMoved
oBrowse:up()
NEXT
ENDIF
WHILE !oBrowse:stabilize(); END
// turn hilite on and restore autoLite status
oBrowse:hilite()
oBrowse:autoLite := lSavAutoL
// restore hitTop and hitBottom status
oBrowse:hitTop := lSavHitTop
oBrowse:hitBottom := lSavHitBot
RETURN nil
//--------------------------------------------------------------------------//