*** empty log message ***
This commit is contained in:
Viktor Szakats
@@ -1,3 +1,16 @@
|
||||
19990803-19:00 GMT+1 Victor Szel <info@szelvesz.hu>
|
||||
* source/rtl/achoice.prg
|
||||
source/rtl/Makefile
|
||||
tests/working/ac_test.prg
|
||||
tests/working/Makefile
|
||||
+ ACHOICE() plus test program AC_TEST added.
|
||||
(Please update other makefiles accordingly)
|
||||
* include/box.ch
|
||||
include/box.h
|
||||
+ XBase++ compatible B_THIN, B_FAT border types added.
|
||||
* include/memoedit.ch
|
||||
+ Some XBase++ extensions added.
|
||||
|
||||
19990803-16:50 GMT+1 Victor Szel <info@szelvesz.hu>
|
||||
* config/win32/gcc.cf
|
||||
config/os2/gcc.cf (not tested)
|
||||
|
||||
@@ -23,4 +23,10 @@
|
||||
#define B_DOUBLE_SINGLE ( Chr(213) + Chr(205) + Chr(184) + Chr(179) + ;
|
||||
Chr(190) + Chr(205) + Chr(212) + Chr(179) )
|
||||
|
||||
#define B_THIN ( Chr(219) + Chr(223) + Chr(219) + Chr(219) + ;
|
||||
Chr(219) + Chr(220) + Chr(219) + Chr(219) )
|
||||
|
||||
#define B_FAT ( Chr(219) + Chr(219) + Chr(219) + Chr(219) + ;
|
||||
Chr(219) + Chr(219) + Chr(219) + Chr(219) )
|
||||
|
||||
#endif /* _BOX_CH */
|
||||
|
||||
@@ -12,5 +12,7 @@
|
||||
#define B_DOUBLE "赏缓纪群"
|
||||
#define B_SINGLE_DOUBLE "帜泛侥雍"
|
||||
#define B_DOUBLE_SINGLE "胀赋就猿"
|
||||
#define B_THIN "圻圹圮圹"
|
||||
#define B_FAT "圹圹圹圹"
|
||||
|
||||
#endif /* HB_BOX_H_ */
|
||||
|
||||
@@ -6,11 +6,11 @@
|
||||
#define _DIRECTRY_CH
|
||||
|
||||
/* Positions for DIRECTORY() array */
|
||||
#define F_NAME 1
|
||||
#define F_SIZE 2
|
||||
#define F_DATE 3
|
||||
#define F_TIME 4
|
||||
#define F_ATTR 5
|
||||
#define F_NAME 1 /* File name */
|
||||
#define F_SIZE 2 /* File size */
|
||||
#define F_DATE 3 /* File date (write) */
|
||||
#define F_TIME 4 /* File time (write) */
|
||||
#define F_ATTR 5 /* File attribute */
|
||||
|
||||
/* Length of DIRECTORY() array */
|
||||
#define F_LEN 5
|
||||
|
||||
@@ -6,19 +6,23 @@
|
||||
#define _MEMOEDIT_CH
|
||||
|
||||
/* User callback status modes */
|
||||
#define ME_IDLE 0 /* Idle, all keys processed */
|
||||
#define ME_UNKEY 1 /* Unknown key, memo unaltered */
|
||||
#define ME_UNKEYX 2 /* Unknown key, memo altered */
|
||||
#define ME_INIT 3 /* Initialization mode */
|
||||
#define ME_IDLE 0 /* Idle, all keys processed */
|
||||
#define ME_UNKEY 1 /* Unknown key, memo unaltered */
|
||||
#define ME_UNKEYX 2 /* Unknown key, memo altered */
|
||||
#define ME_INIT 3 /* Initialization mode */
|
||||
#define ME_REQUEST 4 /* Memoedit requests an input from */
|
||||
/* the user function, e.g. after */
|
||||
/* ME_PASTE */ /* XBase++ extension */
|
||||
|
||||
/* User callback return codes */
|
||||
#define ME_DEFAULT 0 /* Perform default action */
|
||||
#define ME_IGNORE 32 /* Ignore unknown key */
|
||||
#define ME_DATA 33 /* Treat unknown key as data */
|
||||
#define ME_TOGGLEWRAP 34 /* Toggle word-wrap mode */
|
||||
#define ME_TOGGLESCROLL 35 /* Toggle scrolling mode */
|
||||
#define ME_WORDRIGHT 100 /* Perform word-right operation */
|
||||
#define ME_BOTTOMRIGHT 101 /* Perform bottom-right operation */
|
||||
#define ME_DEFAULT 0 /* Perform default action */
|
||||
#define ME_IGNORE 32 /* Ignore unknown key */
|
||||
#define ME_DATA 33 /* Treat unknown key as data */
|
||||
#define ME_TOGGLEWRAP 34 /* Toggle word-wrap mode */
|
||||
#define ME_TOGGLESCROLL 35 /* Toggle scrolling mode */
|
||||
#define ME_WORDRIGHT 100 /* Perform word-right operation */
|
||||
#define ME_BOTTOMRIGHT 101 /* Perform bottom-right operation */
|
||||
#define ME_PASTE 110 /* Paste string into buffer */ /* XBase++ extension */
|
||||
|
||||
/* NOTE: Return codes 1-31 cause MEMOEDIT() to perform the */
|
||||
/* edit action corresponding to the key whose value is returned. */
|
||||
|
||||
@@ -35,6 +35,7 @@ C_SOURCES=\
|
||||
msgxxx.c \
|
||||
|
||||
PRG_SOURCES=\
|
||||
achoice.prg \
|
||||
alert.prg \
|
||||
asort.prg \
|
||||
devoutp.prg \
|
||||
|
||||
628
harbour/source/rtl/achoice.prg
Normal file
628
harbour/source/rtl/achoice.prg
Normal file
@@ -0,0 +1,628 @@
|
||||
/*
|
||||
* $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 )
|
||||
@@ -16,6 +16,7 @@ ifeq ($(PM),)
|
||||
endif
|
||||
ifeq ($(PM),) # PM not defined = build all files
|
||||
PRG_SOURCES=\
|
||||
ac_test.prg \
|
||||
ainstest.prg \
|
||||
and_or.prg \
|
||||
array16.prg \
|
||||
|
||||
221
harbour/tests/working/ac_test.prg
Normal file
221
harbour/tests/working/ac_test.prg
Normal file
@@ -0,0 +1,221 @@
|
||||
*+====================================================================
|
||||
*+
|
||||
*+ Source Module => E:\MULTI\AC_TEST.PRG
|
||||
*+
|
||||
*+ Released to Public Domain.
|
||||
*+
|
||||
*+ Functions: Procedure test()
|
||||
*+ Function cUserFunction()
|
||||
*+
|
||||
*+ Tables: use vendor exclusive
|
||||
*+
|
||||
*+ Reformatted by Click! 1.10 on Aug-13-1997 at 11:39 pm
|
||||
*+
|
||||
*+====================================================================
|
||||
|
||||
#include "achoice.ch"
|
||||
#include "inkey.ch"
|
||||
|
||||
*+--------------------------------------------------------------------
|
||||
*+
|
||||
*+ Procedure test()
|
||||
*+
|
||||
*+--------------------------------------------------------------------
|
||||
*+
|
||||
procedure main()
|
||||
|
||||
local aPrompts := {;
|
||||
"AGRI-PLANTS" ,;
|
||||
"ALAN R. SMITH GREENHOUSES" ,;
|
||||
"ALLAN MURRAY NURSERY, INC." ,;
|
||||
"APOPKA FOREST" ,;
|
||||
"LIGHT HOUSE NURSERIES" ,;
|
||||
"BAUCOM'S" ,;
|
||||
"BAY HILL NURSERY, INC." ,;
|
||||
"BAYWOOD NURSERIES" ,;
|
||||
"BIG OAK NURSERY" ,;
|
||||
"C & N NURSERY" ,;
|
||||
"CHARLES QUALITY PLANTS" ,;
|
||||
"CONNELL FARMS" ,;
|
||||
"DEWAR NURSERIES, INC." ,;
|
||||
"DIAMOND T NURSERY" ,;
|
||||
"DISTINCTIVE PALMS NURSERIES" ,;
|
||||
"DONKAY NURSERY" ,;
|
||||
"DOUG INGRAM & SONS NURSERY" ,;
|
||||
"DRIFTWOOD GARDENS, INC." ,;
|
||||
"ELVA PLANT NURSERY, INC." ,;
|
||||
"ERINON" ,;
|
||||
"EVANS NURSERY" ,;
|
||||
"FANCY PLANTS" ,;
|
||||
"FL.PLANT GROWERSCOOP" ,;
|
||||
"FLORIDA CACTUS INC." ,;
|
||||
"FLOWERING TREE GROWERS, INC." ,;
|
||||
"FLOWERWOOD NURSERY" ,;
|
||||
"FOLIAGE FACTORY TOO" ,;
|
||||
"GATOR GROWERS NURSERY, INC." ,;
|
||||
"GAZEBO LANDSCAPE DESIGN, INC." ,;
|
||||
"GEM ORNAMENTALS" ,;
|
||||
"GRANNY'S GARDEN" ,;
|
||||
"GRAY'S ORNAMENTALS" ,;
|
||||
"GREEN MASTERS INC." ,;
|
||||
"GREEN MEADOW NURSERY" ,;
|
||||
"PIXLEY'S PLANT PLACE" ,;
|
||||
"HARRISON'S NURSERY, INC." ,;
|
||||
"G & G FOLIAGE" ,;
|
||||
"IVEY'S NURSERY, INC." ,;
|
||||
"JB NURSERIES, INC." ,;
|
||||
"JON'S NURSERY" ,;
|
||||
"JONES & JONES NURSERY, INC." ,;
|
||||
"KAGER'S NURSERY" ,;
|
||||
"KIRKLAND'S NURSERY" ,;
|
||||
"LAND OF BROMELIADS" ,;
|
||||
"LANDSCAPE NURSERY, INC." ,;
|
||||
"LIEWALD'S NURSERY INC." ,;
|
||||
"LLOYD & RINGS NURSERY" ,;
|
||||
"LONG VAN DOUNG" ,;
|
||||
"MAPEL'S LANDSCAPE NURSERY" ,;
|
||||
"MILESTONE AGRICULTURE, INC." ,;
|
||||
"MOJICA NURSERY & FRUITS" ,;
|
||||
"NELSON'S ROSES" ,;
|
||||
"PARK GARDENS" ,;
|
||||
"PAUL LUKAS INC." ,;
|
||||
"PECKETT'S INC." ,;
|
||||
"PENANG NURSERY, INC." ,;
|
||||
"PINES III NURERIES" ,;
|
||||
"PINEVIEW NURSERY" ,;
|
||||
"POUL JENSEN NURSERY" ,;
|
||||
"R.P. WELKER" ,;
|
||||
"RICHARD ROGERS NURSERY, INC." ,;
|
||||
"SPRING HILL NURSERY" ,;
|
||||
"T.O. MAHAFFEY, JR." ,;
|
||||
"TUCKER NURSERY" ,;
|
||||
"TURTLE POND NURSERY" ,;
|
||||
"TUTTLE'S NURSERY INC." ,;
|
||||
"VALLEY CACTUS" ,;
|
||||
"WHISPER WINDS, INC." ,;
|
||||
"WHITE ROSE NURSERIES INC." ,;
|
||||
"WOODWAY" ,;
|
||||
"FLORI-DESIGN" ,;
|
||||
"GREEN ACRES FOLIAGE, INC" ,;
|
||||
"FLORAL EXPO" ,;
|
||||
"TORRES NURSERY" ,;
|
||||
"DARRYL KOON" ,;
|
||||
"TRISTAR NURSERY" ,;
|
||||
"KAY WEST NURSERY" ,;
|
||||
"JAYMAR NURSERY" ,;
|
||||
"J D F LANDSCAPE NURSERY" ,;
|
||||
"DEROOSE PLANTS, INC." ,;
|
||||
"THE TREEHOUSE" ,;
|
||||
"COSTELLO'S ARECAS, INC." ,;
|
||||
"FLORICO FOLIAGE" ,;
|
||||
"THE NATIVES" ,;
|
||||
"GREENS NURSERY" ,;
|
||||
"STEWART NURSERIES" ,;
|
||||
"G & T FOLIAGE, INC." ,;
|
||||
"GOOD TIMES NURSERY" ,;
|
||||
"CONCEPTS IN GREENERY, INC." ,;
|
||||
"DUNN BROTHERS CITRUS, INC." ,;
|
||||
"JOHN PLANK GREENHOUSES" ,;
|
||||
"GREENER PASTURES NURSERY" ,;
|
||||
"MULVEHILL NURSERY" ,;
|
||||
"A NU LEAF" ,;
|
||||
"IVY DESIGNS, INC." ,;
|
||||
"B & C TROPICALS" ,;
|
||||
"SPANISH RIVER NURSERY, INC." ,;
|
||||
"JACK CHRISTMAS & ASSOCIATES" ,;
|
||||
"SPECIALIST GROWERS" ,;
|
||||
"HOMRICH NURSERY, INC." ,;
|
||||
"COUNTRYSIDE FOLIAGE, INC." ,;
|
||||
"RFJ COMPANY" ,;
|
||||
"LAKE BRANTLEY PLANT CORP." ,;
|
||||
"MARISTYME" ,;
|
||||
"MERISTEM NURSERY, INC." ,;
|
||||
"TROPIC DECOR - EARL WILSON" ,;
|
||||
"URQUHART'S NURSERY" ,;
|
||||
"ACE PLANT NURSERY" ,;
|
||||
"HATTAWAYS GREENHOUSE, INC." ,;
|
||||
"Florida Plant Growers" ,;
|
||||
"Junior Nursery" ,;
|
||||
"Fox's Nurseries, Inc." ,;
|
||||
"Vaughan Nursery" ,;
|
||||
"MERRYGRO FARMS" ,;
|
||||
"ALL SEASONS NURSERY" ,;
|
||||
"BENCHMARK FOLIAGE" ,;
|
||||
"SAMMY'S NURSERY" ,;
|
||||
"SUNSHINE GROWERS" ,;
|
||||
"Blooming-Fields Nursery" }
|
||||
|
||||
local aPermits := {}
|
||||
local x := 1
|
||||
local nChoice
|
||||
local ncntr
|
||||
|
||||
clear screen
|
||||
|
||||
setcolor( 'GB+/B,GR+/R,,,W/N' )
|
||||
|
||||
asize( aPermits, Len( aPrompts ) )
|
||||
|
||||
for x := 1 to Len( aPrompts )
|
||||
aPermits[ x ] := !( 'V' $ aPrompts[ x ] )
|
||||
next
|
||||
|
||||
#define TEST1
|
||||
#ifdef TEST1
|
||||
for ncntr := 1 to 17
|
||||
aPermits[ nCntr ] := .F.
|
||||
aPermits[ Len( aPrompts ) - nCntr + 1 ] := .F.
|
||||
next
|
||||
aPermits[ 32 ] := .F.
|
||||
aPermits[ 33 ] := .F.
|
||||
aPermits[ 34 ] := .F.
|
||||
#endif
|
||||
|
||||
nChoice := achoice( 5, 10, 20, 70, aPrompts, aPermits, "cUserFunction" )
|
||||
|
||||
setpos( 0, 0 )
|
||||
* clear screen
|
||||
? nChoice
|
||||
|
||||
if nChoice > 0
|
||||
? aPrompts[ nChoice ]
|
||||
endif
|
||||
setpos( maxrow() - 2, 0 )
|
||||
|
||||
return
|
||||
|
||||
*+--------------------------------------------------------------------
|
||||
*+
|
||||
*+ Function cUserFunction()
|
||||
*+
|
||||
*+--------------------------------------------------------------------
|
||||
*+
|
||||
function cUserFunction( nMode, nCurElement, nRowPos )
|
||||
|
||||
local nRetVal := AC_CONT // Default, Continue
|
||||
local nKey := lastkey()
|
||||
do case
|
||||
// After all pending keys are processed, display message
|
||||
case nMode == AC_IDLE
|
||||
@ 0, 0 say padr( ltrim( str( nCurElement ) ), 10 )
|
||||
nRetVal := AC_CONT // Continue ACHOICE()
|
||||
case nMode == AC_HITTOP // Attempt to go past Top
|
||||
@ 0, 0 say "Hit Top "
|
||||
// tone( 100, 3 )
|
||||
case nMode == AC_HITBOTTOM // Attempt to go past Bottom
|
||||
@ 0, 0 say "Hit Bottom"
|
||||
// tone( 100, 3 )
|
||||
case nMode == AC_EXCEPT // Key Exception
|
||||
@ 0, 0 say "Exception "
|
||||
do case
|
||||
case nKey == K_RETURN // If RETURN key, select
|
||||
nRetVal := AC_SELECT
|
||||
case nKey == K_ESC // If ESCAPE key, abort
|
||||
nRetVal := AC_ABORT
|
||||
otherwise
|
||||
nRetVal := AC_GOTO // Otherwise, go to item
|
||||
endcase
|
||||
endcase
|
||||
return nRetVal
|
||||
|
||||
*+ EOF: AC_TEST.PRG
|
||||
Reference in New Issue
Block a user