493 lines
17 KiB
Plaintext
493 lines
17 KiB
Plaintext
/*
|
|
* $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 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 // The number of items
|
|
LOCAL nGap := 0 // 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 := 0 // Return value from user function
|
|
LOCAL nSaveCsr := SetCursor( SC_NONE )
|
|
LOCAL nFrstItem := 0
|
|
LOCAL nLastItem := 0
|
|
LOCAL nCntr
|
|
LOCAL bAction
|
|
LOCAL cKey
|
|
|
|
ColorSelect( CLR_STANDARD )
|
|
|
|
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() + 1 // The bottommost row of the window
|
|
DEFAULT nRight 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 nPos TO 1 // The number of the selected item
|
|
DEFAULT nHiLiteRow TO 0 // The row to be highlighted
|
|
|
|
nNumCols := nRight - nLeft + 1
|
|
nNumRows := nBottom - nTop + 1
|
|
AEval( acItems, {| x | iif( ISCHARACTER( x ), AAdd( acCopy, PadR( x, nNumCols ) ), .F. ) } )
|
|
nItems := Len( acCopy )
|
|
|
|
alSelect := Array( nItems )
|
|
IF ISARRAY( xSelect )
|
|
AFill( alSelect, .T. )
|
|
FOR nCntr := 1 TO Len( xSelect )
|
|
IF nCntr <= nItems
|
|
IF ISCHARACTER( xSelect[ nCntr ] )
|
|
IF Empty( xSelect[ nCntr ] )
|
|
lFinished := .T.
|
|
nPos := 0
|
|
ELSE
|
|
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
|
|
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( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
|
|
ENDIF
|
|
|
|
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
|
|
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
nNewPos := nPos - 1
|
|
DO WHILE !alSelect[ nNewPos ]
|
|
nNewPos --
|
|
ENDDO
|
|
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
ELSE
|
|
DispBegin()
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
|
|
nAtTop := nNewPos
|
|
nPos := Max( nPos, nAtTop + nNumRows - 1 )
|
|
DO WHILE nPos > nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos --
|
|
ENDDO
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
|
|
nNewPos := nPos + 1
|
|
|
|
DO WHILE !alSelect[ nNewPos ]
|
|
nNewPos ++
|
|
ENDDO
|
|
|
|
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
ELSE
|
|
DispBegin()
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
|
|
nAtTop := nNewPos - nNumRows + 1
|
|
nPos := Max( nPos, nAtTop )
|
|
DO WHILE nPos < nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos ++
|
|
ENDDO
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
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( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
nPos := nFrstItem
|
|
nAtTop := nPos
|
|
DispPage( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
ELSE
|
|
nPos := nLastItem
|
|
nAtTop := Max( 1, nPos - nNumRows + 1 )
|
|
DispPage( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
nNewPos := nAtTop
|
|
DO WHILE !alSelect[ nNewPos ]
|
|
nNewPos++
|
|
ENDDO
|
|
IF nNewPos != nPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
nNewPos := nAtTop + nNumRows - 1
|
|
DO WHILE !alSelect[ nNewPos ]
|
|
nNewPos--
|
|
ENDDO
|
|
IF nNewPos != nPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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. !alSelect[ nPos ]
|
|
nPos--
|
|
nAtTop--
|
|
ENDDO
|
|
nAtTop := Max( 1, nAtTop )
|
|
ENDIF
|
|
ENDIF
|
|
DispPage( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
ENDIF
|
|
ELSE
|
|
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
|
|
// On the same page as nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nLastItem
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
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, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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 )
|
|
|
|
cKey := Upper( Chr( nKey ) )
|
|
|
|
// Find next selectable item
|
|
FOR nNewPos := nPos + 1 TO nItems
|
|
IF alSelect[ nNewPos ] .AND. Left( acCopy[ nNewPos ], 1 ) == cKey
|
|
EXIT
|
|
ENDIF
|
|
NEXT
|
|
IF nNewPos == nItems + 1
|
|
FOR nNewPos := 1 TO nPos - 1
|
|
IF alSelect[ nNewPos ] .AND. Left( acCopy[ nNewPos ], 1 ) == cKey
|
|
EXIT
|
|
ENDIF
|
|
NEXT
|
|
ENDIF
|
|
|
|
IF nNewPos != nPos
|
|
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
|
|
// On same page
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
|
|
nPos := nNewPos
|
|
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
|
|
ELSE
|
|
// On different page
|
|
nPos := nNewPos
|
|
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems )
|
|
DispPage( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
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( xUserFunc, 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 PROCEDURE DispPage( acCopy, alSelect, nTop, nLeft, nRight, nNumRows, nPos, nAtTop )
|
|
|
|
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, nLeft, alSelect[ nIndex ], nIndex == nPos )
|
|
ELSE
|
|
ColorSelect( CLR_STANDARD )
|
|
DispOutAt( nRow, nLeft, Space( nRight - nLeft + 1 ) )
|
|
ENDIF
|
|
NEXT
|
|
|
|
DispEnd()
|
|
|
|
SetPos( nSaveRow, nSaveCol )
|
|
|
|
RETURN
|
|
|
|
STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite )
|
|
|
|
ColorSelect( iif( lSelect, ;
|
|
iif( lHiLite, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) )
|
|
|
|
DispOutAt( nRow, nCol, cLine )
|
|
|
|
ColorSelect( CLR_STANDARD )
|
|
|
|
RETURN
|
|
|