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

2009-03-12 16:10 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* source/rtl/achoice.prg
  * tests/ac_test2.prg
    ! ACHOICE() made more Clipper compatible. Still not fully, pls
      continue Clipper/Harbour tests with updated ac_test2.prg.
This commit is contained in:
Viktor Szakats
2009-03-12 15:10:57 +00:00
parent 6037f521f9
commit cefb90ee5e
3 changed files with 70 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
harbour/ChangeLog
View File

@@ -8,6 +8,12 @@
2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-03-12 16:10 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/achoice.prg
* tests/ac_test2.prg
! ACHOICE() made more Clipper compatible. Still not fully, pls
continue Clipper/Harbour tests with updated ac_test2.prg.
2009-03-12 14:00 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+ harbour/tests/ac_test2.prg
+ added achoice() test by Vladislav Lavrecky - many thanks.

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

@@ -152,12 +152,14 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
CASE ( nKey == K_ESC .OR. nMode == AC_NOITEM ) .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nMode := AC_ABORT
nPos := 0
lFinished := .T.
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, 0, nAtTop, nItems, bSelect, nRowsClr )
CASE nKey == K_LDBLCLK .OR. nKey == K_LBUTTONDOWN
nAux := HitTest( nTop, nLeft, nBottom, nRight, MRow(), MCol() )
IF nAux != 0 .AND. ( nNewPos := nAtTop + nAux - 1 ) <= nItems
@@ -396,25 +398,31 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
CASE nKey == K_ENTER .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nMode := AC_SELECT
lFinished := .T.
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, 0, nAtTop, nItems, bSelect, nRowsClr )
CASE nKey == K_RIGHT .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nPos := 0
lFinished := .T.
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, 0, nAtTop, nItems, bSelect, nRowsClr )
CASE nKey == K_LEFT .AND. !lUserFunc
IF nPos != 0
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, .T., .F., nNumCols )
ENDIF
nPos := 0
lFinished := .T.
DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, 0, nAtTop, nItems, bSelect, nRowsClr )
CASE INRANGE( 32, nKey, 255 ) .AND. ( !lUserFunc .OR. nMode == AC_GOTO )
cKey := Upper( Chr( nKey ) )

68
harbour/tests/ac_test2.prg
View File

@@ -20,38 +20,66 @@
*/
#include "inkey.ch"
#include "inkey.ch"
#include "achoice.ch"
function main()
local aMenu1 := {"-Visky-"}
local aMenu2 := {"-Vodka-"}
local aMenu3 := {"-Grapa-"}
//NIL, empty, numeric, and not handled - items
//must be inaccesible and invisible
local aMenu1 := {" --Visky--", "", "not handled"}
local aMenu2 := {" --Vodka--", " --Water--", NIL, "not handled"}
local aMenu3 := {" --Grapa--", 33, "not handled"}
local lExit := .F.
local nCounter := 1
local nKeyPressed
setcolor("W+/N, BG+/B, , , W/N")
cls
@ 2,1 SAY "-Visky- -Vodka- -Grapa-"
@ 2,1 SAY " --Visky-- --Vodka-- --Grapa--"
@ 3,14 SAY "--Water--"
do while !lExit
do case
case nCounter == 1
achoice(2, 1, 2, 7, aMenu1)
case nCounter == 2
achoice(2, 9, 2, 15, aMenu2)
case nCounter == 3
achoice(2, 17, 2, 23, aMenu3)
endcase
do case
case nCounter == 1
achoice(2, 1, 3, 11, aMenu1)
case nCounter == 2
achoice(2, 13, 3, 23, aMenu2, .T., "cUserFunction")
case nCounter == 3
achoice(2, 25, 3, 35, aMenu3, .T., "cUserFunction")
endcase
nKeyPressed := lastkey()
if nKeyPressed == K_ESC
lExit := .T.
elseif nKeyPressed == K_RIGHT
nCounter := iif(nCounter == 3, 1, nCounter+1)
elseif nKeyPressed == K_LEFT
nCounter := iif(nCounter == 1, 3, nCounter-1)
endif
nKeyPressed := lastkey()
if nKeyPressed == K_ESC
lExit := .T.
elseif nKeyPressed == K_RIGHT
nCounter := iif(nCounter == 3, 1, nCounter+1)
elseif nKeyPressed == K_LEFT
nCounter := iif(nCounter == 1, 3, nCounter-1)
endif
enddo
return NIL
//do nothing, just for test
function cUserFunction( nMode, nCurElement, nRowPos )
local nRetVal := AC_CONT
local nKey := LASTKEY()
//dispbox( 0, 0, maxrow(), maxcol(), repl("#",9), "GR+/G" )
if nMode == AC_NOITEM
nRetVal := AC_ABORT
elseif nMode == AC_EXCEPT
do case
case nKey == K_RETURN
nRetVal := AC_SELECT
otherwise
nRetVal := AC_ABORT
endcase
endif
return nRetVal