/* * Author....: Jim Orlowski * CIS ID....: ? * * This is an original work by Jim Orlowski and is placed in the * public domain. * * Modification history: * --------------------- * * Rev 1.4 28 Sep 1991 02:56:56 GLENN * Moved Jim's "Tricks used" comment out of the file header and * into the source code area. * * Rev 1.3 28 Sep 1991 02:52:22 GLENN * Jim's modifications: * * 1. Changed SaveScreen() and RestScreen() to use MaxRow(), MaxCol() * instead of 24,79 * * 2. Added Nantucket's cleaner code for: * - Cleaned up logic around line 334 while loop section * - Added refreshCurrent and another stabilize around line 349 * - TbSkipWhile was redone * Note: Leo's line was changed to: * ELSEIF n > 0 .AND. RecNo() != LastRec() + 1 * * 3. Added DispBegin() and DispEnd() around both Stabilize sections * * * * * Rev 1.2 15 Aug 1991 23:04:20 GLENN * Forest Belt proofread/edited/cleaned up doc * * Rev 1.1 14 Jun 1991 19:53:08 GLENN * Minor edit to file header * * Rev 1.0 01 Apr 1991 01:02:22 GLENN * Nanforum Toolkit * */ /* The tricks are: * * 1. Setting up functions for goTop() and goBottom() so that you can * quickly move to the right record when the user presses the * Ctrl-PgUp ( goTop() ) and Ctrl-PgDn ( goBottom() ) keys. * * 2. Passing and evaluating the block for the TbSkipWhil(). */ #include "inkey.ch" #include "setcurs.ch" FUNCTION ft_BrwsWhl( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; cColorList, cColorShad, nTop, nLeft, nBottom, nRight ) LOCAL b, column, i LOCAL cHead, bField, lKeepScrn, cScrnSave LOCAL cColorSave, cColorBack, nCursSave LOCAL lMore, nKey, nPassRec __defaultNIL( @nFreeze, 0 ) __defaultNIL( @lSaveScrn, .T. ) __defaultNIL( @cColorList, "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" ) __defaultNIL( @cColorShad, "N/N" ) __defaultNIL( @nTop, 2 ) __defaultNIL( @nLeft, 2 ) __defaultNIL( @nBottom, MaxRow() - 2 ) __defaultNIL( @nRight, MaxCol() - 2 ) lKeepScrn := PCount() > 6 dbSeek( cKey ) IF ! Found() .OR. LastRec() == 0 RETURN 0 ENDIF /* make new browse object */ b := TBrowseDB( nTop, nLeft, nBottom, nRight ) /* default heading and column separators */ b:headSep := hb_UTF8ToStrBox( "═╤═" ) b:colSep := hb_UTF8ToStrBox( " │ " ) b:footSep := hb_UTF8ToStrBox( "═╧═" ) /* add custom 'TbSkipWhil' (to handle passed condition) */ b:skipBlock := {| x | TbSkipWhil( x, bWhileCond ) } /* Set up substitute goto top and goto bottom */ /* with While's top and bottom records */ b:goTopBlock := {|| TbWhileTop( cKey ) } b:goBottomBlock := {|| TbWhileBot( cKey ) } /* colors */ b:colorSpec := cColorList /* add a column for each field in the current workarea */ FOR i := 1 TO Len( aFields ) cHead := aFields[ i, 1 ] bField := aFields[ i, 2 ] /* make the new column */ column := TBColumnNew( cHead, bField ) /* these are color setups from tbdemo.prg from Nantucket */ // IF cType == "N" // column:defColor := { 5, 6 } // column:colorBlock := {| x | iif( x < 0, { 7, 8 }, { 5, 6 } ) } // ELSE // column:defColor := { 3, 4 } // ENDIF /* To simplify I just used 3rd and 4th colors from passed cColorList */ /* This way 1st is SAY, 2nd is GET, 3rd and 4th are used here, /* 5th is Unselected Get, extras can be used as in tbdemo.prg */ column:defColor := { 3, 4 } b:addColumn( column ) NEXT /* freeze columns */ IF nFreeze != 0 b:freeze := nFreeze ENDIF /* save old screen and colors */ IF lSaveScrn cScrnSave := SaveScreen( 0, 0, MaxRow(), MaxCol() ) ENDIF cColorSave := SetColor() /* Background Color Is Based On First Color In Passed cColorList */ cColorBack := iif( "," $ cColorList, ; SubStr( cColorList, 1, At( ",", cColorList ) - 1 ), cColorList ) IF ! lKeepScrn SetColor( cColorBack ) hb_Scroll() ENDIF /* make a window shadow */ hb_Scroll( nTop + 1, nLeft + 1, nBottom + 1, nRight + 1,,, cColorShad ) hb_Scroll( nTop, nLeft, nBottom, nRight,,, cColorBack ) SetColor( cColorSave ) nCursSave := SetCursor( SC_NONE ) lMore := .T. DO WHILE lMore /* stabilize the display */ nKey := 0 DispBegin() DO WHILE nKey == 0 .AND. ! b:stable b:stabilize() nKey := Inkey() ENDDO DispEnd() IF b:stable /* display is stable */ IF b:hitTop .OR. b:hitBottom Tone( 125, 0 ) ENDIF // Make sure that the current record is showing // up-to-date data in case we are on a network. DispBegin() b:refreshCurrent() b:forceStable() DispEnd() /* everything's done. just wait for a key */ nKey := Inkey( 0 ) ENDIF /* process key */ SWITCH nKey CASE K_DOWN b:down() EXIT CASE K_UP b:up() EXIT CASE K_PGDN b:pageDown() EXIT CASE K_PGUP b:pageUp() EXIT CASE K_CTRL_PGUP b:goTop() EXIT CASE K_CTRL_PGDN b:goBottom() EXIT CASE K_RIGHT b:Right() EXIT CASE K_LEFT b:Left() EXIT CASE K_HOME b:home() EXIT CASE K_END b:end() EXIT CASE K_CTRL_LEFT b:panLeft() EXIT CASE K_CTRL_RIGHT b:panRight() EXIT CASE K_CTRL_HOME b:panHome() EXIT CASE K_CTRL_END b:panEnd() EXIT CASE K_ESC nPassRec := 0 lMore := .F. EXIT CASE K_ENTER nPassRec := RecNo() lMore := .F. EXIT ENDSWITCH ENDDO /* restore old screen */ IF lSaveScrn RestScreen( 0, 0, MaxRow(), MaxCol(), cScrnSave ) ENDIF SetCursor( nCursSave ) SetColor( cColorSave ) RETURN nPassRec STATIC FUNCTION TbSkipWhil( n, bWhileCond ) LOCAL i := 0 IF n == 0 .OR. LastRec() == 0 dbSkip( 0 ) // significant on a network ELSEIF n > 0 .AND. RecNo() != LastRec() + 1 WHILE i < n dbSkip() IF Eof() .OR. ! Eval( bWhileCond ) dbSkip( -1 ) EXIT ENDIF i++ ENDDO ELSEIF n < 0 DO WHILE i > n dbSkip( -1 ) IF Bof() EXIT ELSEIF ! Eval( bWhileCond ) dbSkip() EXIT ENDIF i-- ENDDO ENDIF RETURN i STATIC FUNCTION TbWhileTop( cKey ) dbSeek( cKey ) RETURN NIL // SeekLast: Finds Last Record For Matching Key // Developed By Jon Cole // With softseek set on, seek the first record after condition. // This is accomplished by incrementing the right most character of the // string cKey by one ascii character. After SEEKing the new string, // back up one record to get to the last record which matches cKey. STATIC FUNCTION TbWhileBot( cKey ) dbSeek( Left( cKey, Len( cKey ) - 1 ) + Chr( Asc( Right( cKey, 1 ) ) + 1 ), .T. ) dbSkip( -1 ) RETURN NIL