986df3694e
+ contrib/hbct/tests/dates4.prg
- tests/dates4.prg
* contrib/hbnf/byt2bit.prg
* contrib/hbnf/dectobin.prg
* contrib/hbnf/popadder.prg
* tests/ac_test2.prg
* tests/ainstest.prg
* tests/and_or.prg
* tests/array16.prg
* tests/arrays.prg
* tests/begin.prg
* tests/byref.prg
* tests/calling.prg
* tests/clasinh.prg
* tests/clasinit.prg
* tests/classes.prg
* tests/clsnv.prg
* tests/codebloc.prg
* tests/dates.prg
* tests/debugtst.prg
* tests/destruct.prg
* tests/dirtest.prg
* tests/dynobj.prg
* tests/exittest.prg
* tests/fib.prg
* tests/files.prg
* tests/fornext.prg
* tests/fsplit.prg
* tests/gtchars.prg
* tests/ifelse.prg
* tests/inherit.prg
* tests/inifiles.prg
* tests/initexit.prg
* tests/inkeytst.prg
* tests/inline.prg
* tests/iotest.prg
* tests/iotest2.prg
* tests/longdev.prg
* tests/longstr2.prg
* tests/memvar.prg
* tests/multiarg.prg
* tests/newrdd.prg
* tests/nums.prg
* tests/objasign.prg
* tests/objects.prg
* tests/overload.prg
* tests/passref.prg
* tests/procname.prg
* tests/readhrb.prg
* tests/returns.prg
* tests/rto_get.prg
* tests/rto_tb.prg
* tests/sbartest.prg
* tests/setkeys.prg
* tests/speed.prg
* tests/statfun.prg
* tests/statics.prg
* tests/stripem.prg
* tests/switch.prg
* tests/tb1.prg
* tests/test_all.prg
* tests/testbrw.prg
* tests/testcls.prg
* tests/testerro.prg
* tests/testfor.prg
* tests/testmem.prg
* tests/testntx.prg
* tests/testop.prg
* tests/testpp.prg
* tests/testrdd2.prg
* tests/teststr.prg
* tests/testvars.prg
* tests/testwarn.prg
* tests/tstasort.prg
* tests/tstdbi.prg
* tests/tstmacro.prg
* tests/varparam.prg
* tests/vidtest.prg
* various cleanups, fixes and formatting
now most tests are warning and error free
113 lines
2.5 KiB
Plaintext
113 lines
2.5 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* ScrollBar class test
|
|
*
|
|
* Harbour Project source code
|
|
* http://harbour-project.org/
|
|
*
|
|
* Example donated by Diego Pego,
|
|
* modified by Alejandro de Garate
|
|
*/
|
|
|
|
#include "directry.ch"
|
|
#include "achoice.ch"
|
|
#include "inkey.ch"
|
|
|
|
#define B_THIN ( Chr( 219 ) + Chr( 223 ) + Chr( 219 ) + Chr( 219 ) + ;
|
|
Chr( 219 ) + Chr( 220 ) + Chr( 219 ) + Chr( 219 ) )
|
|
|
|
PROCEDURE Main()
|
|
|
|
InitScrlBar()
|
|
|
|
RETURN
|
|
|
|
FUNCTION InitScrlBar()
|
|
|
|
LOCAL tmpFileList, i
|
|
MEMVAR aFileList, filesScroll
|
|
PRIVATE aFileList := {}, filesScroll
|
|
|
|
CLS
|
|
SetBlink( .F. )
|
|
@ 0, 0, 24, 79 BOX REPLIC( Chr( 178 ), 9 ) COLOR "GR+/W*"
|
|
@ 4, 28 SAY " Directory " COLOR "W+/B"
|
|
@ 5, 28, 15, 60 BOX B_THIN + " " COLOR "W/W*"
|
|
|
|
// get the current folder files to display on the aChoice menu
|
|
tmpFileList := Directory()
|
|
|
|
FOR i := 1 TO Len( tmpFileList )
|
|
AAdd( aFileList, tmpFileList[ i ][ F_NAME ] )
|
|
NEXT
|
|
|
|
filesScroll := ScrollBar( 06, 14, 60, NIL, 1 )
|
|
|
|
filesScroll:total := Len( aFileList )
|
|
|
|
filesScroll:SetColor( "W+/W, W+/W" ) // New method!
|
|
SET COLOR TO "N/W*, W+/B,,,W/N"
|
|
|
|
filesScroll:display()
|
|
|
|
i := AChoice( 06, 29, 14, 59, aFileList, , "updateFilesScroll" )
|
|
|
|
@ 23, 0 SAY iif( i < 1, "", aFileList[ i ] ) COLOR "N/W*"
|
|
SET COLOR TO
|
|
@ 24, 0
|
|
|
|
RETURN 0
|
|
|
|
// function used to update scrollbar
|
|
|
|
FUNCTION updateFilesScroll( modo )
|
|
|
|
LOCAL newPos, valRet := AC_CONT // Default to continue
|
|
LOCAL ultTecla := LastKey()
|
|
|
|
MEMVAR filesScroll
|
|
|
|
newPos := filesScroll:current
|
|
|
|
DO CASE
|
|
CASE ultTecla == K_CTRL_PGUP
|
|
newPos := 1
|
|
CASE ultTecla == K_CTRL_PGDN
|
|
newPos := filesScroll:total
|
|
CASE ultTecla == K_CTRL_HOME
|
|
newPos := newPos - ( filesScroll:barLength + 1 )
|
|
CASE ultTecla == K_CTRL_END
|
|
newPos := newPos + ( filesScroll:barLength + 1 )
|
|
CASE ultTecla == K_PGUP
|
|
newPos := newPos - ( filesScroll:barLength + 1 )
|
|
CASE ultTecla == K_PGDN
|
|
newPos := newPos + ( filesScroll:barLength + 1 )
|
|
CASE ultTecla == K_UP
|
|
newPos--
|
|
CASE ultTecla == K_DOWN
|
|
newPos++
|
|
CASE modo == AC_EXCEPT
|
|
DO CASE
|
|
CASE ultTecla == K_RETURN
|
|
valRet := AC_SELECT
|
|
CASE ultTecla == K_ESC
|
|
valRet := AC_ABORT
|
|
OTHERWISE
|
|
valRet := AC_GOTO
|
|
ENDCASE
|
|
ENDCASE
|
|
|
|
IF newPos < 1
|
|
newPos := 1
|
|
ELSEIF newPos >= filesScroll:total
|
|
newPos := filesScroll:total
|
|
ENDIF
|
|
|
|
filesScroll:current := newPos
|
|
filesScroll:update()
|
|
|
|
RETURN valRet
|