629 lines
22 KiB
Plaintext
629 lines
22 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
Harbour Project source code
|
|
www - http://www.Harbour-Project.org
|
|
|
|
A pure Clipper emulation of the ACHOICE function.
|
|
|
|
Author: Peter Townsend <cephas@tpgi.com.au>
|
|
Code donated to the Public Domain
|
|
*/
|
|
|
|
#include "inkey.ch"
|
|
#include "setcurs.ch"
|
|
#include "set.ch"
|
|
#include "achoice.ch"
|
|
#include "common.ch"
|
|
|
|
/* $DOC$
|
|
* $FUNCNAME$
|
|
* ACHOICE()
|
|
*
|
|
* $ONELINER$
|
|
* Allows selection of an element from an array
|
|
*
|
|
* $SYNTAX$
|
|
* ACHOICE(<nTop>, <nLeft>, <nBottom>, <nRight>,
|
|
* <acMenuItems>,
|
|
* [<alSelectableItems> | <lSelectableItems>],
|
|
* [<cUserFunction>],
|
|
* [<nInitialItem>],
|
|
* [<nWindowRow>]) --> nPosition
|
|
*
|
|
* $ARGUMENTS$
|
|
* nTop - topmost row used to display array (default 0)
|
|
* nLeft - leftmost row used to display array (default 0)
|
|
* nBottom - bottommost row used to display array (default MAXROW())
|
|
* nRight - rightmost row used to display array (default MAXCOL())
|
|
* acMenuItems - the character array of items from which to select
|
|
* alSelectableItems - an array of items, either logical or character,
|
|
* which is used to determine if a particular item
|
|
* may be selected. If the type of a given item is
|
|
* character, it is macro evaluated, and the result
|
|
* is expected to be a logical. A value of .T. means
|
|
* that the item may be selected, .F. that it may not.
|
|
* (See next argument: lSelectableItems)
|
|
* lSelectableItems - a logical value which is used to apply to all
|
|
* items in acMenuItems. If .T., all items may be
|
|
* selected; if .F., none may be selected.
|
|
* (See previous argument: alSelectableItems)
|
|
* Default .T.
|
|
* cUserFunction - the name of a function to be called which may
|
|
* effect special processing of keystrokes. It is
|
|
* specified without parentheses or parameters.
|
|
* When it is called, it will be supplied with the
|
|
* parameters: nMode, nCurElement, and nRowPos.
|
|
* Default NIL.
|
|
* nInitialItem - the number of the element to be highlighted as
|
|
* the current item when the array is initally
|
|
* displayed. 1 origin. Default 1.
|
|
* nWindowRow - the number of the window row on which the initial
|
|
* item is to be displayed. 0 origin. Default 0.
|
|
*
|
|
* $RETURNS$
|
|
* nPosition - the number of the item to be selected, or 0 if the
|
|
* selection was aborted.
|
|
*
|
|
* $DESCRIPTION$
|
|
* Allows selection of an element from an array.
|
|
* Please see standard Clipper documentation for ACHOICE for
|
|
* additional detail.
|
|
*
|
|
* $EXAMPLES$
|
|
* aItems := { "One", "Two", "Three" }
|
|
* nChoice := ACHOICE( 10, 10, 20, 20, aItems )
|
|
* IF nChoice == 0
|
|
* ? "You did not choose an item"
|
|
* ELSE
|
|
* ? "You chose element " + LTRIM( STR( nChoice ) )
|
|
* ?? " which has a value of " + aItems[ nChoice ]
|
|
* ENDIF
|
|
*
|
|
* $SEEALSO$
|
|
* ACHOICE() - as supplied in Clipper
|
|
*
|
|
* $INCLUDE$
|
|
* common.ch
|
|
* inkey.ch
|
|
* set.ch
|
|
* setcurs.ch
|
|
* achoice.ch
|
|
*
|
|
* $END$
|
|
*/
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Function achoice()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, cUserFunc, nPos, nHiLytRow )
|
|
|
|
local nNumCols := 0 // Number of columns in the window
|
|
local nNumRows := 0 // Number of rows in the window
|
|
local acCopy := {} // A padded copy of the items
|
|
local alSelect := {} // Select permission
|
|
local nNewPos := 0 // The next item to be selected
|
|
local lFinished := .F. // Is processing finished?
|
|
local nKey := 0 // The keystroke to be processed
|
|
local nMode := AC_IDLE // The current operating mode
|
|
local nAtTop := 1 // The number of the item at the top
|
|
local nAtBtm := 1 // The number of the item at the bottom
|
|
local nItems := 0 // The number of items
|
|
local nGap := 0 // The number of lines between top and current lines
|
|
// Block used to search for items
|
|
local bScan := { | cX | if( left( cX, 1 ) == upper( chr( nKey ) ), .T., .F. ) }
|
|
// Is a user function to be used?
|
|
local lUserFunc := ( !empty( cUserFunc ) )
|
|
local nUserFunc := 0 // Return value from user function
|
|
local bUserFunc := { || AC_ABORT } // Block form of user function
|
|
local cLoClr := Before( ",", setcolor() )
|
|
local cHiClr := Before( ",", After( ",", setcolor() ) )
|
|
local cUnClr := After( ",", After( ",", After( ",", After( ",", setcolor() ) ) ) )
|
|
local nSaveCsr := setcursor( SC_NONE )
|
|
local nFrstItem := 0
|
|
local nLastItem := 0
|
|
local nCntr
|
|
|
|
IF lUserFunc
|
|
bUserFunc := cUserFunc
|
|
endif
|
|
|
|
IF empty( cHiClr )
|
|
cHiClr := After( "/", cLoClr ) + "/" + Before( "/", cLoClr )
|
|
endif
|
|
|
|
IF empty( cUnClr )
|
|
cUnClr := cLoClr
|
|
endif
|
|
|
|
DEFAULT nTop to 0 // The topmost row of the window
|
|
DEFAULT nLft to 0 // The leftmost column of the window
|
|
DEFAULT nBtm to maxrow() + 1 // The bottommost row of the windows
|
|
DEFAULT nRyt to maxcol() + 1 // 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 cUserFunc to NIL // Optional function for key exceptions
|
|
DEFAULT nPos to 1 // The number of the selected item
|
|
DEFAULT nHiLytRow to 0 // The row to be highlighted
|
|
|
|
nNumCols := nRyt - nLft + 1
|
|
nNumRows := nBtm - nTop + 1
|
|
aeval( acItems, { | x, n | if( valtype( x ) == "C", aadd( acCopy, padr( x, nNumCols ) ), .F. ) } )
|
|
nItems := len( acCopy )
|
|
|
|
alSelect := array( nItems )
|
|
IF valtype( xSelect ) == "A"
|
|
afill( alSelect, .T. )
|
|
for nCntr := 1 to len( xSelect )
|
|
IF nCntr <= nItems
|
|
IF valtype( xSelect[ nCntr ] ) == "C"
|
|
IF empty( xSelect[ nCntr ] )
|
|
lFinished := .T.
|
|
nPos := 0
|
|
else
|
|
/* TODO: When macro evaluation will work, this should be commented out:
|
|
alSelect[ nCntr ] := &( xSelect[ nCntr ] )
|
|
*/
|
|
endif
|
|
else
|
|
alSelect[ nCntr ] := xSelect[ nCntr ]
|
|
endif
|
|
else
|
|
nCntr := len( xSelect ) + 1
|
|
endif
|
|
next
|
|
else
|
|
afill( alSelect, xSelect )
|
|
endif
|
|
|
|
IF !lFinished
|
|
|
|
nFrstItem := ascan( alSelect, .T. ) // First valid item
|
|
|
|
IF nFrstItem == 0
|
|
nLastItem := 0
|
|
nPos := 0
|
|
nMode := AC_NOITEM
|
|
else
|
|
nMode := AC_IDLE
|
|
nLastItem := nItems // Last valid item
|
|
do while ( !alSelect[ nLastItem ] )
|
|
nLastItem --
|
|
enddo
|
|
endif
|
|
|
|
// Ensure hilighted item can be selected
|
|
nPos := Between( nFrstItem, nPos, nLastItem )
|
|
|
|
// Force hilighted row to be valid
|
|
nHiLytRow := Between( 0, nHiLytRow, nNumRows - 1 )
|
|
|
|
// Force the topmost item to be a valid index of the array
|
|
nAtTop := Between( 1, max( 1, nPos - nHiLytRow ), 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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
|
|
endif
|
|
|
|
do while ( !lFinished )
|
|
|
|
IF nMode != AC_GOTO .and. nMode != AC_NOITEM
|
|
nKey := Inkey( 0 )
|
|
nMode := AC_IDLE
|
|
endif
|
|
|
|
do case
|
|
case ( ( nKey == K_ESC ) .or. ( nMode == AC_NOITEM ) ) .and. ( !lUserFunc )
|
|
nMode := AC_ABORT
|
|
nPos := 0
|
|
lFinished := .T.
|
|
|
|
case nKey == K_UP
|
|
IF nPos == nFrstItem
|
|
nMode := AC_HITTOP
|
|
IF nAtTop > max( 1, nPos - nNumRows + 1 )
|
|
nAtTop := max( 1, nPos - nNumRows + 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
nNewPos := nPos - 1
|
|
do while !alSelect[ nNewPos ]
|
|
nNewPos --
|
|
enddo
|
|
IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
else
|
|
dispbegin()
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
|
|
nAtTop := nNewPos
|
|
nPos := max( nPos, nAtTop + nNumRows - 1 )
|
|
do while nPos > nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos --
|
|
enddo
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
dispend()
|
|
endif
|
|
endif
|
|
|
|
case nKey == K_DOWN
|
|
* 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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
|
|
nNewPos := nPos + 1
|
|
|
|
do while !alSelect[ nNewPos ]
|
|
nNewPos ++
|
|
enddo
|
|
|
|
IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
else
|
|
dispbegin()
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
|
|
nAtTop := nNewPos - nNumRows + 1
|
|
nPos := max( nPos, nAtTop )
|
|
do while nPos < nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos ++
|
|
enddo
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
dispend()
|
|
endif
|
|
|
|
endif
|
|
|
|
case ( ( nKey == K_HOME ) .or. ( nKey == K_CTRL_PGUP ) ) .and. ( !lUserFunc )
|
|
IF nPos == nFrstItem
|
|
IF nAtTop == max( 1, nPos - nNumRows + 1 )
|
|
nMode := AC_HITTOP
|
|
else
|
|
nAtTop := max( 1, nPos - nNumRows + 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
nPos := nFrstItem
|
|
nAtTop := nPos
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
|
|
case ( ( nKey == K_END ) .or. ( nKey == K_CTRL_PGDN ) ) .and. ( !lUserFunc )
|
|
IF nPos == nLastItem
|
|
IF nAtTop == min( nLastItem, nItems - nNumRows + 1 )
|
|
nMode := AC_HITBOTTOM
|
|
else
|
|
nAtTop := min( nLastItem, nItems - nNumRows + 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
else
|
|
nPos := nLastItem
|
|
nAtTop := max( 1, nPos - nNumRows + 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
nNewPos := nAtTop
|
|
do while !alSelect[ nNewPos ]
|
|
nNewPos ++
|
|
enddo
|
|
IF nNewPos != nPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
nNewPos := nAtTop + nNumRows - 1
|
|
do while !alSelect[ nNewPos ]
|
|
nNewPos --
|
|
enddo
|
|
IF nNewPos != nPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
IF InRange( nAtTop, nFrstItem, nAtTop + nNumRows - 1 )
|
|
* On same page as nFrstItem
|
|
nPos := nFrstItem
|
|
nAtTop := max( nPos - nNumRows + 1, 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
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. ( !alSelect[ nPos ] )
|
|
nPos --
|
|
nAtTop --
|
|
enddo
|
|
nAtTop := max( 1, nAtTop )
|
|
endif
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
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( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
else
|
|
IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
|
|
* On the same page as nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
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. ( !alSelect[ nPos ] )
|
|
nPos ++
|
|
nAtTop ++
|
|
enddo
|
|
* Don't leave blank space on the page
|
|
do while ( nAtTop + nNumRows - 1 ) > nItems
|
|
nAtTop --
|
|
enddo
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
endif
|
|
|
|
case ( nKey == K_ENTER ) .and. ( !lUserFunc )
|
|
nMode := AC_SELECT
|
|
lFinished := .T.
|
|
|
|
case ( nKey == K_RIGHT ) .and. ( !lUserFunc )
|
|
nPos := 0
|
|
lFinished := .T.
|
|
|
|
case ( nKey == K_LEFT ) .and. ( !lUserFunc )
|
|
nPos := 0
|
|
lFinished := .T.
|
|
|
|
case InRange( 32, nKey, 255 ) .and. ( ( !lUserFunc ) .or. ( nMode == AC_GOTO ) )
|
|
* Find next selectable item
|
|
nNewPos := ascan( acCopy, bScan, nPos + 1 )
|
|
do while InRange( nPos, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] )
|
|
nNewPos := ascan( acCopy, bScan, nNewPos + 1 )
|
|
enddo
|
|
|
|
IF nNewPos == 0
|
|
* Loop back to beginning item, if there is one
|
|
nNewPos := ascan( acCopy, bScan )
|
|
do while InRange( 1, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] )
|
|
nNewPos := ascan( acCopy, bScan, nNewPos + 1 )
|
|
enddo
|
|
endif
|
|
|
|
IF InRange( nFrstItem, nNewPos, nLastItem ) .and. alSelect[ nNewPos ]
|
|
IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
* On same page
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr )
|
|
else
|
|
* On different page
|
|
nPos := nNewPos
|
|
nAtTop := Between( 1, nPos - nNumRows + 1, nItems )
|
|
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
endif
|
|
endif
|
|
|
|
nMode := AC_IDLE
|
|
|
|
case ( nMode == AC_GOTO )
|
|
* Garbage collect gotos which aren't valid ASCII characters
|
|
nMode := AC_IDLE
|
|
|
|
otherwise
|
|
IF nKey == 0 // No keystroke
|
|
nMode := AC_IDLE
|
|
else
|
|
nMode := AC_EXCEPT
|
|
endif
|
|
|
|
endcase
|
|
|
|
IF lUserFunc
|
|
nUserFunc := do( bUserFunc, nMode, nPos, nPos - nAtTop )
|
|
// DISPVAR nUserFunc
|
|
do case
|
|
case nUserFunc == AC_ABORT
|
|
lFinished := .T.
|
|
nPos := 0
|
|
case nUserFunc == AC_SELECT
|
|
lFinished := .T.
|
|
case nUserFunc == AC_CONT
|
|
* Do nothing
|
|
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
|
|
endif
|
|
|
|
enddo
|
|
|
|
setcursor( nSaveCsr )
|
|
|
|
return ( nPos )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function DispPage()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 15 - function achoice()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr )
|
|
|
|
local nCntr
|
|
local nRow // Screen row
|
|
local nIndex // Array index
|
|
local nSaveRow := row() // Position at start of routine
|
|
local nSaveCol := col() // Position at start of routine
|
|
local nArrLen := len( acCopy )
|
|
|
|
dispbegin()
|
|
for nCntr := 1 to nNumRows
|
|
nRow := nTop + nCntr - 1
|
|
nIndex := nCntr + nAtTop - 1
|
|
IF InRange( 1, nIndex, nArrLen )
|
|
DispLine( acCopy[ nIndex ], nRow, nLft, alSelect[ nIndex ], nIndex == nPos, cLoClr, cHiClr, cUnClr )
|
|
else
|
|
@ nRow, nLft say space( len( acCopy[ 1 ] ) ) color cLoClr
|
|
endif
|
|
next
|
|
dispend()
|
|
|
|
setpos( nSaveRow, nSaveCol )
|
|
|
|
return ( NIL )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function DispLine()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 20 - function achoice()
|
|
*+ 1 - static function disppage()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt, cLoClr, cHiClr, cUnClr )
|
|
|
|
DEFAULT lHiLyt to .F.
|
|
|
|
@ nRow, nCol say cLine color if( lSelect, if( lHiLyt, cHiClr, cLoClr ), cUnClr )
|
|
|
|
return ( NIL )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function InRange()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 10 - function achoice()
|
|
*+ 1 - static function disppage()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function InRange( xLo, xVal, xHi )
|
|
|
|
return ( ( xVal >= xLo ) .and. ( xVal <= xHi ) )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function Between()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 4 - function achoice()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function Between( xLo, xVal, xHi )
|
|
|
|
return ( min( max( xLo, xVal ), xHi ) )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function Before()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 3 - function achoice()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function Before( cDelim, cValue )
|
|
|
|
local cRetVal := cValue
|
|
|
|
IF cDelim $ cValue
|
|
cRetVal := left( cValue, at( cDelim, cValue ) - 1 )
|
|
endif
|
|
|
|
return ( cRetVal )
|
|
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
*+ Static Function After()
|
|
*+
|
|
*+ Called from ( achoice.prg ) 6 - function achoice()
|
|
*+
|
|
*+--------------------------------------------------------------------
|
|
*+
|
|
static function After( cDelim, cValue )
|
|
|
|
local cRetVal := ""
|
|
|
|
IF cDelim $ cValue
|
|
cRetVal := substr( cValue, at( cDelim, cValue ) + 1 )
|
|
endif
|
|
|
|
return ( cRetVal )
|