fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
1c7c124232ffefe9ff417ba460e5ba2c04feee21
harbour-core/harbour/source/rtl/achoice.prg
Viktor Szakats 3219e88ed7 2009-06-13 13:49 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) 
* source/rtl/achoice.prg
    ! Partially reverted this commit:
      https://sourceforge.net/apps/trac/harbour-project/changeset/10605
      After this change, activating DBU menus with all items disabled
      (f.e. F7/F8) caused app hang.
      This line:
         nUserFunc := iif( nMode != AC_NOITEM,;
            Do( xUserFunc, nMode, nPos, nPos - nAtTop ), NIL )
      Was now changed back to this:
         nUserFunc := Do( xUserFunc, nMode, nPos, nPos - nAtTop )
      ac_test2.prg still seem to function fine after this, but
      I'd kindly like to ask Vladislav Lavrecky to make tests
      again, maybe we need another fix here.

  * source/vm/evalhb.c
    * Minor formatting.

  * contrib/hbtip/client.prg
    * Minor formatting.
    ! :ReadToFile() nMode param check.

  * utils/hbmk2/hbmk2.prg
    * Cleanup to variable name prefixes.

  * contrib/xhb/Makefile
  + contrib/xhb/xthrow.prg
    + Added THROW() function for xhb compatibility.
      This is written in Harbour, based on hbcompat.ch
      and has Harbour license + exception.

  + contrib/xhb/xcstr.prg
  + contrib/xhb/xdbmodst.prg
  * contrib/xhb/Makefile
    + Ported following old functions from xhb:
      CSTRTOVAL(), STRINGTOLITERAL(), VALTOPRG(), PRGEXPTOVAL()
    + Ported following new functions from xhb:
      VALTOARRAY(), VALTODATE(), VALTOHASH(), VALTOLOGICAL()
      VALTONUMBER(), VALTOARRAY(), VALTOTYPE(),
      DBMODIFYSTRUCTURE(), DBIMPORT(), DBMERGE()
      (borrowed from xhb, work of Ron Pinkas)
2009-06-13 11:56:32 +00:00

642 lines
22 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* ACHOICE() function
*
* Released to Public Domain by Peter Townsend <cephas@tpgi.com.au>
* www - http://www.harbour-project.org
*
*/
#include "achoice.ch"
#include "color.ch"
#include "common.ch"
#include "inkey.ch"
#include "setcurs.ch"
#define INRANGE( xLo, xVal, xHi ) ( xVal >= xLo .AND. xVal <= xHi )
#define BETWEEN( xLo, xVal, xHi ) Min( Max( xLo, xVal ), xHi )
FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPos, nHiLiteRow )
LOCAL nNumCols // Number of columns in the window
LOCAL nNumRows // Number of rows in the window
LOCAL nRowsClr // Number of rows to clear
LOCAL alSelect // Select permission
LOCAL nNewPos := 0 // The next item to be selected
LOCAL lFinished // Is processing finished?
LOCAL nKey := 0 // The keystroke to be processed
LOCAL nMode // The current operating mode
LOCAL nAtTop // The number of the item at the top
LOCAL nItems := 0 // The number of items
LOCAL nGap // The number of lines between top and current lines
// Block used to search for items
LOCAL lUserFunc // Is a user function to be used?
LOCAL nUserFunc // Return value from user function
LOCAL nSaveCsr := SetCursor( SC_NONE )
LOCAL nFrstItem := 0
LOCAL nLastItem := 0
LOCAL bAction
LOCAL cKey
LOCAL nAux
LOCAL bSelect := { | x, y | iif( ISLOGICAL( x ), x, iif( !Empty( x ), ( y := &( x ), iif( ISLOGICAL( y ), y, .T. ) ), .T.) ) }
ColorSelect( CLR_STANDARD )
/* NOTE: Undocumented parameter passing handled. ACHOICE()
is called in such way in RLDIALG.PRG from RL tool
supplied with Clipper 5.x. 6th parameter is the
user function and 7th parameter is zero (empty I
suppose). [vszakats] */
IF Empty( xUserFunc ) .AND. ValType( xSelect ) $ "CB"
xUserFunc := xSelect
xSelect := NIL
ENDIF
lUserFunc := !Empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB"
DEFAULT nTop TO 0 // The topmost row of the window
DEFAULT nLeft TO 0 // The leftmost column of the window
DEFAULT nBottom TO MaxRow() // The bottommost row of the window
DEFAULT nRight TO MaxCol() // The rightmost column of the window
DEFAULT acItems TO {} // The items from which to choose
DEFAULT xSelect TO .T. // Array or logical, what is selectable
DEFAULT nPos TO 1 // The number of the selected item
DEFAULT nHiLiteRow TO 0 // The row to be highlighted
nNumCols := nRight - nLeft + 1
IF nRight > MaxCol()
nRight := MaxCol()
ENDIF
IF nBottom > MaxRow()
nBottom := MaxRow()
ENDIF
nNumRows := nBottom - nTop + 1
IF ISARRAY( xSelect )
alSelect := xSelect
ELSE
alSelect := Array( Len( acItems ) )
AFill( alSelect, xSelect )
ENDIF
nMode := Ach_Limits( @nFrstItem, @nLastItem, @nItems, bSelect, alSelect, acItems )
IF nMode == AC_NOITEM
nPos := 0
ENDIF
// Ensure hilighted item can be selected
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
// Force hilighted row to be valid
nHiLiteRow := BETWEEN( 0, nHiLiteRow, nNumRows - 1 )
// Force the topmost item to be a valid index of the array
nAtTop := BETWEEN( 1, Max( 1, nPos - nHiLiteRow ), nItems )
// Ensure as much of the selection area as possible is covered
IF ( nAtTop + nNumRows - 1 ) > nItems
nAtTop := Max( 1, nItems - nNumrows + 1 )
ENDIF
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect, nItems )
lFinished := .F.
DO WHILE !lFinished
IF nMode != AC_GOTO .AND. nMode != AC_NOITEM
nKey := Inkey( 0 )
nMode := AC_IDLE
ENDIF
DO CASE
CASE ( bAction := SetKey( nKey ) ) != NIL
Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" )
IF Empty( NextKey() )
KEYBOARD Chr( 255 )
Inkey()
nKey := 0
ENDIF
nRowsClr := Min( nNumRows, nItems )
nMode := Ach_Limits( @nFrstItem, @nLastItem, @nItems, bSelect, alSelect, acItems )
IF nMode == AC_NOITEM
nPos := 0
nAtTop := Max( 1, nPos - nNumRows + 1 )
ELSE
DO WHILE nPos < nLastItem .AND. !Eval( bSelect, alSelect[ nPos ] )
nPos++
ENDDO
IF nPos > nLastItem
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
ENDIF
nAtTop := Min( nAtTop, nPos )
IF nAtTop + nNumRows - 1 > nItems
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems - nNumRows + 1 )
ENDIF
IF nAtTop < 1
nAtTop := 1
ENDIF
ENDIF
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect, nRowsClr )
CASE ( nKey == K_ESC .OR. nMode == AC_NOITEM ) .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nMode := AC_ABORT
nPos := 0
lFinished := .T.
CASE nKey == K_LDBLCLK .OR. nKey == K_LBUTTONDOWN
nAux := HitTest( nTop, nLeft, nBottom, nRight, MRow(), MCol() )
IF nAux != 0 .AND. ( nNewPos := nAtTop + nAux - 1 ) <= nItems
IF Eval( bSelect, alSelect[ nNewPos ] )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
IF nKey == K_LDBLCLK
Keyboard( Chr( K_ENTER ) )
ENDIF
ENDIF
ENDIF
#ifdef HB_C52_STRICT
CASE nKey == K_UP
#else
CASE nKey == K_UP .OR. nKey == K_MWFORWARD
#endif
IF nPos == nFrstItem
nMode := AC_HITTOP
IF nAtTop > Max( 1, nPos - nNumRows + 1 )
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
nNewPos := nPos - 1
DO WHILE !Eval( bSelect, alSelect[ nNewPos ] )
nNewPos--
ENDDO
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
DispBegin()
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
hb_scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
nAtTop := nNewPos
nPos := Max( nPos, nAtTop + nNumRows - 1 )
DO WHILE nPos > nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos--
ENDDO
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
DispEnd()
ENDIF
ENDIF
#ifdef HB_C52_STRICT
CASE nKey == K_DOWN
#else
CASE nKey == K_DOWN .OR. nKey == K_MWBACKWARD
#endif
// Find the next selectable item to display
IF nPos == nLastItem
nMode := AC_HITBOTTOM
IF nAtTop < Min( nPos, nItems - nNumRows + 1 )
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
nNewPos := nPos + 1
DO WHILE !Eval( bSelect, alSelect[ nNewPos ] )
nNewPos++
ENDDO
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
DispBegin()
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
hb_scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
nAtTop := nNewPos - nNumRows + 1
nPos := Max( nPos, nAtTop )
DO WHILE nPos < nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos++
ENDDO
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
DispEnd()
ENDIF
ENDIF
CASE nKey == K_CTRL_PGUP .OR. ( nKey == K_HOME .AND. !lUserFunc )
IF nPos == nFrstItem
IF nAtTop == Max( 1, nPos - nNumRows + 1 )
nMode := AC_HITTOP
ELSE
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
nPos := nFrstItem
nAtTop := nPos
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
CASE nKey == K_CTRL_PGDN .OR. ( nKey == K_END .AND. !lUserFunc )
IF nPos == nLastItem
IF nAtTop == Min( nLastItem, nItems - nNumRows + 1 )
nMode := AC_HITBOTTOM
ELSE
nAtTop := Min( nLastItem, nItems - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
nPos := nLastItem
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ENDIF
CASE nKey == K_CTRL_HOME
IF nPos == nFrstItem
IF nAtTop == Max( 1, nPos - nNumRows + 1 )
nMode := AC_HITTOP
ELSE
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
nNewPos := nAtTop
DO WHILE !Eval( bSelect, alSelect[ nNewPos ] )
nNewPos++
ENDDO
IF nNewPos != nPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ENDIF
ENDIF
CASE nKey == K_CTRL_END
IF nPos == nLastItem
IF nAtTop == Min( nPos, nItems - nNumRows + 1 )
nMode := AC_HITBOTTOM
ELSE
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
nNewPos := Min( nAtTop + nNumRows - 1, nItems )
DO WHILE !Eval( bSelect, alSelect[ nNewPos ] )
nNewPos--
ENDDO
IF nNewPos != nPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ENDIF
ENDIF
CASE nKey == K_PGUP
IF nPos == nFrstItem
nMode := AC_HITTOP
IF nAtTop > Max( 1, nPos - nNumRows + 1 )
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
IF INRANGE( nAtTop, nFrstItem, nAtTop + nNumRows - 1 )
// On same page as nFrstItem
nPos := nFrstItem
nAtTop := Max( nPos - nNumRows + 1, 1 )
ELSE
IF ( nPos - nNumRows + 1 ) < nFrstItem
nPos := nFrstItem
nAtTop := nFrstItem
ELSE
nPos := Max( nFrstItem, nPos - nNumRows + 1 )
nAtTop := Max( 1, nAtTop - nNumRows + 1 )
DO WHILE nPos > nFrstItem .AND. !Eval( bSelect, alSelect[ nPos ] )
nPos--
nAtTop--
ENDDO
nAtTop := Max( 1, nAtTop )
ENDIF
ENDIF
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
CASE nKey == K_PGDN
IF nPos == nLastItem
nMode := AC_HITBOTTOM
IF nAtTop < Min( nPos, nItems - nNumRows + 1 )
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ELSE
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
// On the same page as nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
nGap := nPos - nAtTop
nPos := Min( nLastItem, nPos + nNumRows - 1 )
IF ( nPos + nNumRows - 1 ) > nLastItem
// On the last page
nAtTop := nLastItem - nNumRows + 1
nPos := Min( nLastItem, nAtTop + nGap )
ELSE
// Not on the last page
nAtTop := nPos - nGap
ENDIF
// Make sure that the item is selectable
DO WHILE nPos < nLastItem .AND. !Eval( bSelect, alSelect[ nPos ] )
nPos++
nAtTop++
ENDDO
// Don't leave blank space on the page
DO WHILE ( nAtTop + nNumRows - 1 ) > nItems
nAtTop--
ENDDO
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ENDIF
CASE nKey == K_ENTER .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nMode := AC_SELECT
lFinished := .T.
CASE nKey == K_RIGHT .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nPos := 0
lFinished := .T.
CASE nKey == K_LEFT .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nPos := 0
lFinished := .T.
CASE INRANGE( 32, nKey, 255 ) .AND. ( !lUserFunc .OR. nMode == AC_GOTO )
cKey := Upper( Chr( nKey ) )
// Find next selectable item
FOR nNewPos := nPos + 1 TO nItems
IF Eval( bSelect, alSelect[ nNewPos ] ) .AND. Upper( Left( acItems[ nNewPos ], 1 ) ) == cKey
EXIT
ENDIF
NEXT
IF nNewPos == nItems + 1
FOR nNewPos := 1 TO nPos - 1
IF Eval( bSelect, alSelect[ nNewPos ] ) .AND. Upper( Left( acItems[ nNewPos ], 1 ) ) == cKey
EXIT
ENDIF
NEXT
ENDIF
IF nNewPos != nPos
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
// On same page
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
// On different page
nPos := nNewPos
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems )
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect )
ENDIF
ENDIF
nMode := AC_IDLE
CASE nMode == AC_GOTO
// Garbage collect gotos which aren't valid ASCII characters
nMode := AC_IDLE
OTHERWISE
IF nMode != AC_NOITEM
IF nKey == 0 // No keystroke
nMode := AC_IDLE
ELSE
nMode := AC_EXCEPT
ENDIF
ENDIF
ENDCASE
IF lUserFunc
nUserFunc := Do( xUserFunc, nMode, nPos, nPos - nAtTop )
IF ISNUMBER( nUserFunc )
DO CASE
CASE nUserFunc == AC_ABORT .OR. nMode == AC_NOITEM
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
lFinished := .T.
nPos := 0
CASE nUserFunc == AC_SELECT
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
lFinished := .T.
CASE nUserFunc == AC_CONT .OR. nUserFunc == AC_REDRAW
// Do nothing
nMode := AC_CONT
CASE nUserFunc == AC_GOTO
// Do nothing. The next keystroke won't be read and
// this keystroke will be processed as a goto.
nMode := AC_GOTO
ENDCASE
IF nPos > 0 .AND. nMode != AC_GOTO
nRowsClr := Min( nNumRows, nItems )
nMode := Ach_Limits( @nFrstItem, @nLastItem, @nItems, bSelect, alSelect, acItems )
IF nMode == AC_NOITEM
nPos := 0
nAtTop := Max( 1, nPos - nNumRows + 1 )
ELSE
DO WHILE nPos < nLastItem .AND. !Eval( bSelect, alSelect[ nPos ] )
nPos++
ENDDO
IF nPos > nLastItem
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
ENDIF
nAtTop := Min( nAtTop, nPos )
IF nAtTop + nNumRows - 1 > nItems
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems - nNumRows + 1 )
ENDIF
IF nAtTop < 1
nAtTop := 1
ENDIF
ENDIF
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nItems, bSelect, nRowsClr )
ENDIF
ELSE
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nPos := 0
lFinished := .T.
ENDIF
ENDIF
ENDDO
SetCursor( nSaveCsr )
RETURN nPos
STATIC FUNCTION HitTest( nTop, nLeft, nBottom, nRight, mRow, mCol )
IF mCol >= nLeft .AND. ;
mCol <= nRight .AND. ;
mRow >= nTop .AND. ;
mRow <= nBottom
RETURN mRow - nTop + 1
ENDIF
RETURN 0
STATIC PROCEDURE DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop, nArrLen, bSelect, nRowsClr )
LOCAL nCntr
LOCAL nRow // Screen row
LOCAL nIndex // Array index
DEFAULT nRowsClr TO nNumRows
DispBegin()
FOR nCntr := 1 TO Min( nNumRows, nRowsClr )
nRow := nTop + nCntr - 1
nIndex := nCntr + nAtTop - 1
IF INRANGE( 1, nIndex, nArrLen )
DispLine( acItems[ nIndex ], nRow, nLeft, Eval( bSelect, alSelect[ nIndex ] ), nIndex == nPos, nRight - nLeft + 1 )
ELSE
ColorSelect( CLR_STANDARD )
hb_dispOutAt( nRow, nLeft, Space( nRight - nLeft + 1 ) )
ENDIF
NEXT
DispEnd()
RETURN
STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite, nNumCols )
ColorSelect( iif( lSelect .AND. ISCHARACTER( cLine ), ;
iif( lHiLite, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) )
hb_dispOutAt( nRow, nCol, iif( ISCHARACTER( cLine ), PadR( cLine, nNumCols ), Space( nNumCols ) ) )
ColorSelect( CLR_STANDARD )
RETURN
STATIC FUNCTION Ach_Limits( nFrstItem, nLastItem, nItems, bSelect, alSelect, acItems )
LOCAL nMode
LOCAL nCntr
nItems := 0
FOR nCntr := 1 TO Len( acItems )
IF ISCHARACTER( acItems[ nCntr ] ) .AND. Len( acItems[ nCntr ] ) > 0
nItems++
ELSE
EXIT
ENDIF
NEXT
nFrstItem := AScan( alSelect, bSelect ) // First valid item
IF nFrstItem == 0
nLastItem := 0
ELSE
nMode := AC_IDLE
nLastItem := nItems // Last valid item
DO WHILE nLastItem > 0 .AND. !Eval( bSelect, alSelect[ nLastItem ] )
nLastItem--
ENDDO
ENDIF
IF nLastItem <= 0
nMode := AC_NOITEM
nLastItem := nItems
ENDIF
RETURN nMode
Reference in New Issue View Git Blame Copy Permalink