TIP: Click on subject to list as thread! ANSI
echo: foxpro
to: ALL
from: DAVID POWELL
date: 1997-01-26 18:13:00
subject: FPLib(): BigMover pt.1 of 5

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)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.