Hi All:
OK. Here it is, slightly flawed-- but I ran out of time. The UpArrow
routine isn't perfect, but it won't crash.
*:*******************************************************************
*: Program...........: BigMover.prg
*: Author............: David Lee Powell
*: Project...........: Common
*: Created...........: 1-Jan-1994
*: Copyright.........: None: Public Domain
*) Description.......: Multiple choice picklist
*: Syntax............: DO BigMover WITH jaAvail, "jcArrayName", ;
*: : [jcAvail], [jcSelect], [jnWinTop]
*: Parameter list....: jaAvail - Incoming array itself
*: : jcArray - Name of outgoing array
*: : jcAvail - Text for top of Available array (option)
*: : jcSelect - Text for top of Selected array (option)
*: : jnWinTop - Top of window definition (option)
*: Platform..........: DOS/WINDOWS 2.5
*: Major change list.: None
*: Called by.........: Any
*: Calls.............: None
*:*******************************************************************
PARA jaAvail, jcArray, jcAvail, jcSelect, jnWinTop
PRIV ALL LIKE j*
jnParms = PARA()
jcAlias = ALIA()
SET TALK OFF
SET SAFE OFF
SET ESCA OFF
IF jnParms < 2
=Alarm()
WAIT WIND "Needs an ARRAY of data and an array NAME" TIMEOUT 2
RELE ALL LIKE j*
RETU
ENDI
IF jnParms < 3
jcAvail = " Available "
ELSE
jcAvail = PADC( ALLT( jcAvail ), LEN(ALLT( jcAvail )) + 2 )
ENDI
IF jnParms < 4
jcSelect = " Selected "
ELSE
jcSelect = PADC( ALLT( jcSelect ), LEN(ALLT( jcSelect )) + 2 )
ENDI
IF jnParms < 5 && Optimize size of windows
jnHominy = ALEN( jaAvail )
IF jnHominy > 9
jnWinTop = 12
ELSE
jnWinTop = 22 - jnHominy
ENDI
ENDI
jnWinBott = 23
DEFI WIND wsHelp FROM 24,00 TO 24,79 NONE COLO SCHE 8
ACTI WIND wsHelp
@ 00,00 SAY PADC( "F1: Help", 80 )
FOR j1 = 1 TO ALEN( jaAvail )
jaAvail[ j1 ] = LEFT( jaAvail[ j1 ] + SPAC(36), 36 )
NEXT
DIME jaSelect[ 1 ]
=ACOPY( jaAvail, jaSelect, 1, 1, 1) && Create target array's 1st element
j1 = 1
j2 = 1
jnWindow = 1
DIME jaPointer[ 2 ] && Array pointers
STOR 0 TO jaPointer && Zero both elements
Max = jnWinBott - jnWinTop - 1
Max = MIN( ALEN( jaAvail ), Max )
DIME jaTotRecs[ 2 ] && Array counters
jaTotRecs[ 1 ] = ALEN( jaAvail )
jaTotRecs[ 2 ] = 0
SET COLO OF SCHE 1 TO ,W+/R
jcNormVid = SCHE( 1, 1 ) && for normal color
jcHighVid = SCHE( 1, 2 ) && for focused color
DEFI WIND wrAvail FROM jnWinTop,00 TO jnWinBott,39 ;
TITL jcAvail
DEFI WIND wrSelect FROM jnWinTop,40 TO jnWinBott,79 ;
TITL jcSelect
jnWRows = WROW()
jnWindow = 2
=WinClean()
jnWindow = 1
=WinClean()
SET CURS OFF
ON KEY LABE SpaceBar DO MoveElem
ON KEY LABE LeftMouse DO MuaDib
ON KEY LABE Tab DO WinSwitch
ON KEY LABE PgDn DO PageDown
ON KEY LABE PgUp DO PageUp
ON KEY LABE DnArrow DO DownArrow
ON KEY LABE UpArrow DO UpArrow
ON KEY LABE Home DO Home
ON KEY LABE End DO End
ON KEY LABE F1 DO MoveHelp
ON KEY LABE F2 DO MoveLeft
ON KEY LABE F3 DO MoveRight
FOR jk = 65 TO 90 && Hit the alphabet
cmd = "ON KEY LABE " + CHR( jk ) + " DO Letter"
&cmd
NEXT
=Bright()
READ VALI Done()
POP KEY ALL
RELE WIND wrAvail, wrSelect, wsHelp
SET CURS ON
IF ! EMPT( jcAlias )
SELE ( jcAlias )
ENDI
PUBL &jcArray[ 1 ]
=ACOPY( jaSelect, &jcArray )
RELE ALL LIKE j*
RETU
*!*******************************************************************
*! Function..........: Done()
*! Author............: David Lee Powell
*! Project...........: Common
*! Created...........: 1-Jan-1994
*! Copyright.........: None: Public Domain
*) Description.......: Read Valid for BigMover
*! Syntax............: None
*! Parameter list....: None
*! Platform..........: DOS
*! Major change list.: None
*! Called by.........: BigMover READ
*! Calls.............: None
*!*******************************************************************
FUNC Done
RETU ( LASTKEY() = 27 )
--- Maximus/2 3.01
---------------
* Origin: * MacSavvy OS/2 BBS * Dallas, Texas * 972-250-4479 * (1:124/1208)
|