fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

19991020-21:30 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-10-20 19:50:32 +00:00
parent 31bd7f8443
commit 0510c54133
4 changed files with 338 additions and 311 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
harbour/ChangeLog
View File

@@ -1,3 +1,14 @@
19991020-21:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/achoice.prg
% FUNCTION -> PROCEDURE for speed.
% Two small functions converted to macros for speed.
* Formatted. (if() -> iif(), <> -> !=, some variable names standardized,
S87 style comments * -> //, indent errors, etc.)
* source/rtl/asort.prg
% FUNCTION -> PROCEDURE for speed.
* include/rddsys.h
* Small aligning.
19991020-22:58 GMT+3 Alexander Kresin
* source/pp/hbpp.c
* Fixed bugs, reported by Antonio Linares, Victor Szel and Guy Roussin
@@ -10,7 +21,6 @@
* contrib/odbc/harbour.mdb
* These files I got from Felipe Coury
19991020-20:23 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/alert.prg
source/rtl/browdb.prg

4
harbour/include/rddapi.h
View File

@@ -40,7 +40,7 @@
/* RDD virtual machine integration functions */
extern int hb_rddGetCurrentWorkAreaNumber( void );
extern int hb_rddGetCurrentWorkAreaNumber( void );
extern ERRCODE hb_rddSelectWorkAreaAlias( char * szAlias );
extern ERRCODE hb_rddSelectWorkAreaNumber( int iArea );
extern ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias );
@@ -48,7 +48,7 @@ extern ERRCODE hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol );
extern ERRCODE hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol );
extern ERRCODE hb_rddFieldGet( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol );
extern ERRCODE hb_rddFieldPut( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol );
extern void hb_rddShutDown( void );
extern void hb_rddShutDown( void );
/* Flags for DBTRANSINFO */

629
harbour/source/rtl/achoice.prg
View File

@@ -11,12 +11,12 @@
*
*/
#include "inkey.ch"
#include "setcurs.ch"
#include "set.ch"
#include "achoice.ch"
#include "common.ch"
#include "color.ch"
#include "common.ch"
#include "inkey.ch"
#include "set.ch"
#include "setcurs.ch"
/* $DOC$
* $FUNCNAME$
@@ -94,464 +94,481 @@
* $END$
*/
function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, xUserFunc, nPos, nHiLytRow )
#define INRANGE( xLo, xVal, xHi ) ( xVal >= xLo .AND. xVal <= xHi )
#define BETWEEN( xLo, xVal, xHi ) Min( Max( xLo, xVal ), xHi )
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
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
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"
lUserFunc := !Empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB"
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 nPos to 1 // The number of the selected item
DEFAULT nHiLytRow to 0 // The row to be highlighted
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 windows
DEFAULT nRight TO MaxCol() + 1 // The rightmost column of the window
nNumCols := nRyt - nLft + 1
nNumRows := nBtm - nTop + 1
aeval( acItems, { | x | if( ISCHARACTER( x ), aadd( acCopy, padr( x, nNumCols ) ), .F. ) } )
nItems := len( acCopy )
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
alSelect := array( nItems )
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 )
AFill( alSelect, .T. )
FOR nCntr := 1 TO Len( xSelect )
IF nCntr <= nItems
IF ISCHARACTER( xSelect[ nCntr ] )
IF empty( xSelect[ nCntr ] )
IF Empty( xSelect[ nCntr ] )
lFinished := .T.
nPos := 0
else
ELSE
/* TODO: When macro evaluation will work, this should be commented out:
alSelect[ nCntr ] := &( xSelect[ nCntr ] )
*/
endif
else
ENDIF
ELSE
alSelect[ nCntr ] := xSelect[ nCntr ]
endif
else
nCntr := len( xSelect ) + 1
endif
next
else
afill( alSelect, xSelect )
endif
ENDIF
ELSE
nCntr := Len( xSelect ) + 1
ENDIF
NEXT
ELSE
AFill( alSelect, xSelect )
ENDIF
IF !lFinished
nFrstItem := ascan( alSelect, .T. ) // First valid item
nFrstItem := AScan( alSelect, .T. ) // First valid item
IF nFrstItem == 0
nLastItem := 0
nPos := 0
nMode := AC_NOITEM
else
ELSE
nMode := AC_IDLE
nLastItem := nItems // Last valid item
do while ( !alSelect[ nLastItem ] )
nLastItem --
enddo
endif
DO WHILE !alSelect[ nLastItem ]
nLastItem--
ENDDO
ENDIF
// Ensure hilighted item can be selected
nPos := Between( nFrstItem, nPos, nLastItem )
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
// Force hilighted row to be valid
nHiLytRow := Between( 0, nHiLytRow, nNumRows - 1 )
nHiLiteRow := BETWEEN( 0, nHiLiteRow, nNumRows - 1 )
// Force the topmost item to be a valid index of the array
nAtTop := Between( 1, max( 1, nPos - nHiLytRow ), nItems )
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
IF ( nAtTop + nNumRows - 1 ) > nItems
nAtTop := Max( 1, nItems - nNumrows + 1 )
ENDIF
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
endif
ENDIF
do while ( !lFinished )
DO WHILE !lFinished
IF nMode != AC_GOTO .and. nMode != AC_NOITEM
IF nMode != AC_GOTO .AND. nMode != AC_NOITEM
nKey := Inkey( 0 )
nMode := AC_IDLE
endif
ENDIF
do case
DO CASE
CASE ( bAction := SetKey( nKey ) ) != NIL
case ( bAction := setkey( nKey ) ) <> NIL
eval( bAction, procname( 1 ), procline( 1 ), "" )
if empty( nextkey() )
keyboard chr( 255 )
inkey()
Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" )
IF Empty( NextKey() )
KEYBOARD Chr( 255 )
Inkey()
nKey := 0
endif
ENDIF
CASE ( nKey == K_ESC .OR. nMode == AC_NOITEM ) .AND. !lUserFunc
case ( ( nKey == K_ESC ) .or. ( nMode == AC_NOITEM ) ) .and. ( !lUserFunc )
nMode := AC_ABORT
nPos := 0
lFinished := .T.
case nKey == K_UP
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 )
endif
else
IF nAtTop > Max( 1, nPos - nNumRows + 1 )
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ELSE
nNewPos := nPos - 1
do while !alSelect[ nNewPos ]
DO WHILE !alSelect[ nNewPos ]
nNewPos --
enddo
IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
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 ), nLft, alSelect[ nPos ], .T. )
else
dispbegin()
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
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 ), nLft, alSelect[ nPos ], .F. )
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 ), nLft, alSelect[ nPos ], .T. )
dispend()
endif
endif
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
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 )
endif
else
IF nAtTop < Min( nPos, nItems - nNumRows + 1 )
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ELSE
nNewPos := nPos + 1
do while !alSelect[ nNewPos ]
DO WHILE !alSelect[ nNewPos ]
nNewPos ++
enddo
ENDDO
IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
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 ), nLft, alSelect[ nPos ], .T. )
else
dispbegin()
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
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 ), nLft, alSelect[ nPos ], .F. )
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 ), nLft, alSelect[ nPos ], .T. )
dispend()
endif
ENDDO
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
DispEnd()
ENDIF
endif
ENDIF
CASE nKey == K_CTRL_PGUP .OR. ( nKey == K_HOME .AND. !lUserFunc )
case nKey == K_CTRL_PGUP .or. ( nKey == K_HOME .and. !lUserFunc )
IF nPos == nFrstItem
IF nAtTop == max( 1, nPos - nNumRows + 1 )
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 )
endif
else
ELSE
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ELSE
nPos := nFrstItem
nAtTop := nPos
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop )
endif
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
CASE nKey == K_CTRL_PGDN .OR. ( nKey == K_END .AND. !lUserFunc )
case nKey == K_CTRL_PGDN .or. ( nKey == K_END .and. !lUserFunc )
IF nPos == nLastItem
IF nAtTop == min( nLastItem, nItems - nNumRows + 1 )
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 )
endif
else
IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
ELSE
nAtTop := Min( nLastItem, nItems - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, 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 ), nLft, alSelect[ nPos ], .T. )
else
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
ELSE
nPos := nLastItem
nAtTop := max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop )
endif
endif
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ENDIF
CASE nKey == K_CTRL_HOME
case nKey == K_CTRL_HOME
IF nPos == nFrstItem
IF nAtTop == max( 1, nPos - nNumRows + 1 )
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 )
endif
else
ELSE
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ELSE
nNewPos := nAtTop
do while !alSelect[ nNewPos ]
nNewPos ++
enddo
DO WHILE !alSelect[ nNewPos ]
nNewPos++
ENDDO
IF nNewPos != nPos
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
nPos := nNewPos
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. )
endif
endif
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
ENDIF
ENDIF
CASE nKey == K_CTRL_END
case nKey == K_CTRL_END
IF nPos == nLastItem
IF nAtTop == min( nPos, nItems - nNumRows + 1 )
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 )
endif
else
ELSE
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ELSE
nNewPos := nAtTop + nNumRows - 1
do while !alSelect[ nNewPos ]
nNewPos --
enddo
DO WHILE !alSelect[ nNewPos ]
nNewPos--
ENDDO
IF nNewPos != nPos
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. )
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. )
nPos := nNewPos
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. )
endif
endif
DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. )
ENDIF
ENDIF
CASE nKey == K_PGUP
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 )
endif
else
IF InRange( nAtTop, nFrstItem, nAtTop + nNumRows - 1 )
* On same page as nFrstItem
IF nAtTop > Max( 1, nPos - nNumRows + 1 )
nAtTop := Max( 1, nPos - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, 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 )
DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop )
else
if ( nPos - nNumRows + 1 ) < nFrstItem
nAtTop := Max( nPos - nNumRows + 1, 1 )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
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 )
endif
endif
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, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ENDIF
CASE nKey == K_PGDN
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 )
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. )
IF nAtTop < Min( nPos, nItems - nNumRows + 1 )
nAtTop := Min( nPos, nItems - nNumRows + 1 )
DispPage( acCopy, alSelect, nTop, nLeft, 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 ), nLft, alSelect[ nPos ], .T. )
else
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
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
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 )
endif
endif
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, nNumRows, nPos, nAtTop )
ENDIF
ENDIF
CASE nKey == K_ENTER .AND. !lUserFunc
case ( nKey == K_ENTER ) .and. ( !lUserFunc )
nMode := AC_SELECT
lFinished := .T.
case ( nKey == K_RIGHT ) .and. ( !lUserFunc )
CASE nKey == K_RIGHT .AND. !lUserFunc
nPos := 0
lFinished := .T.
case ( nKey == K_LEFT ) .and. ( !lUserFunc )
CASE nKey == K_LEFT .AND. !lUserFunc
nPos := 0
lFinished := .T.
case InRange( 32, nKey, 255 ) .and. ( ( !lUserFunc ) .or. ( nMode == AC_GOTO ) )
CASE INRANGE( 32, nKey, 255 ) .AND. ( !lUserFunc .OR. nMode == AC_GOTO )
cKey := upper( chr( nKey ) )
cKey := Upper( Chr( nKey ) )
* Find next selectable item
// Find next selectable item
FOR nNewPos := nPos + 1 TO nItems
IF alSelect[ nNewPos ] .AND. left( acCopy[ nNewPos ], 1 ) == cKey
EXIT
ENDIF
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
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 ), nLft, alSelect[ nPos ], .F. )
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 ), nLft, alSelect[ nPos ], .T. )
else
* On different page
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, nLft, nNumRows, nPos, nAtTop )
endif
endif
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems )
DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop )
ENDIF
ENDIF
nMode := AC_IDLE
case ( nMode == AC_GOTO )
* Garbage collect gotos which aren't valid ASCII characters
CASE nMode == AC_GOTO
// Garbage collect gotos which aren't valid ASCII characters
nMode := AC_IDLE
otherwise
OTHERWISE
IF nKey == 0 // No keystroke
nMode := AC_IDLE
else
ELSE
nMode := AC_EXCEPT
endif
ENDIF
endcase
ENDCASE
IF lUserFunc
nUserFunc := do( xUserFunc, nMode, nPos, nPos - nAtTop )
nUserFunc := Do( xUserFunc, nMode, nPos, nPos - nAtTop )
// DISPVAR nUserFunc
do case
case nUserFunc == AC_ABORT
DO CASE
CASE nUserFunc == AC_ABORT
lFinished := .T.
nPos := 0
case nUserFunc == AC_SELECT
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.
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
ENDCASE
enddo
ENDIF
setcursor( nSaveCsr )
ENDDO
return nPos
SetCursor( nSaveCsr )
static function DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop )
RETURN nPos
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 )
STATIC PROCEDURE DispPage( acCopy, alSelect, nTop, nLeft, 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
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 )
else
IF INRANGE( 1, nIndex, nArrLen )
DispLine( acCopy[ nIndex ], nRow, nLeft, alSelect[ nIndex ], nIndex == nPos )
ELSE
ColorSelect( CLR_STANDARD )
SetPos( nRow, nLft )
DispOut( space( len( acCopy[ 1 ] ) ) )
endif
next
dispend()
SetPos( nRow, nLeft )
DispOut( Space( Len( acCopy[ 1 ] ) ) )
ENDIF
NEXT
setpos( nSaveRow, nSaveCol )
DispEnd()
return NIL
SetPos( nSaveRow, nSaveCol )
static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt )
RETURN
ColorSelect( if( lSelect, ;
if( lHiLyt, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) )
STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite )
ColorSelect( iif( lSelect, ;
iif( lHiLite, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) )
SetPos( nRow, nCol )
DispOut( cLine )
ColorSelect( CLR_STANDARD )
return NIL
static function InRange( xLo, xVal, xHi )
return ( xVal >= xLo ) .and. ;
( xVal <= xHi )
static function Between( xLo, xVal, xHi )
return min( max( xLo, xVal ), xHi )
RETURN

4
harbour/source/rtl/asort.prg
View File

@@ -90,7 +90,7 @@ FUNCTION ASort( aArray, nStart, nCount, bBlock )
* For instructions :
* http://monty.cnri.reston.va.us/grail/demo/quicksort/quicksort.htm
*/
STATIC FUNCTION QuickSort( aArray, nLeft, nRight, bBlock )
STATIC PROCEDURE QuickSort( aArray, nLeft, nRight, bBlock )
LOCAL nUp := nLeft
LOCAL nDown := nRight
@@ -131,5 +131,5 @@ STATIC FUNCTION QuickSort( aArray, nLeft, nRight, bBlock )
QuickSort( aArray, nUp , nRight, bBlock )
ENDIF
RETURN NIL
RETURN