Category : BASIC Source Code
Archive   : BWTOOL02.ZIP
Filename : POPLIST.SUB

'This version of POPLIST is for QuickBASIC version 4.0 ONLY!

'***********************************************************************
SUB POPLIST(HEADER$,SHOWITEMS%,MAXITEMS%,ITEM$(1),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SLCT%) STATIC
DEFINT A-Z
FRAME%=4
IF SHOWITEMS > MAXITEMS THEN SHOWITEMS=MAXITEMS

'Determine width of window from length of items

WINDLEN=LEN(HEADER$)
FOR J=1 TO MAXITEMS
IF LEN(ITEM$(J)) > WINDLEN THEN WINDLEN=LEN(ITEM$(J))
NEXT J

'If Quadrant is in ROW:COL format, extract Row and Column

IF INSTR(QUADRANT$,":")<>0 THEN GOSUB GETORD:GOTO GO1

'Determine Position based on Quadrant Parameter and size of menu

QUADRANT=VAL(QUADRANT$)
IF QUADRANT >4 OR QUADRANT <0 THEN QUADRANT=0
IF QUADRANT=0 THEN CROW=12:CCOL=40 ELSE ON QUADRANT GOSUB QUAD1,QUAD2,QUAD3,QUAD4
ULR=CROW-((SHOWITEMS+2)/2-.5)
ULC=CCOL-((WINDLEN/2)-.5)
LRR=ULR+SHOWITEMS+1
LRC=ULC+WINDLEN-1

'Create Window for List

GO1: CALL MAKEWIND(ULR,ULC,LRR,LRC,FRAME,FORE,BACK,GROW,SHADOW,LABEL$)

'Place Header in Window

TEMPHDR$=SPACE$(WINDLEN)
IF LEN(HEADER$)<> WINDLEN THEN GOSUB PUTHDR

ATTR=(HBACK AND 7)*16+HFORE
ROW=ULR:COL=ULC
CALL FASTPRT(HEADER$,ROW,COL,ATTR)
ATTR=(BACK AND 7)*16+FORE
ROW=ULR+1:COL=ULC
DAT$=STRING$(WINDLEN,205)
CALL FASTPRT(DAT$,ROW,COL,ATTR)

'Set current choice to List Item #1, Set Beginning and Ending values,
'Display 'More...' message and enter Loop

SLCT=1
BEGVAL=1
ENDVAL=SHOWITEMS
GOSUB FILL

LOPE: GOSUB PRESS:'Get KeyPress
IF KP$=CHR$(13) OR KP$=CHR$(27) THEN GOTO DONE
GOTO LOPE

'Check for KeyPress and sound error if not UP ARROW, DOWN ARROW, HOME, END, PAGE UP, PAGE DOWN, or RETURN

PRESS: KP$=INKEY$
IF KP$="" THEN GOTO PRESS
IF KP$=CHR$(13) THEN RETURN
IF KP$=CHR$(27) THEN SLCT=0:RETURN
IF LEN(KP$)=1 THEN SOUND 1000,1:SOUND 1500,2:SOUND 500,1:GOTO PRESS

'Process DOWN ARROW KeyPress

DOWN: IF ASC(RIGHT$(KP$,1))=80 THEN OLD=SLCT:SLCT=SLCT+1 ELSE GOTO UP
IF SLCT > MAXITEMS THEN SLCT = MAXITEMS:SOUND 1000,1:SOUND 1500,2:SOUND 500,1
IF (SLCT > ENDVAL) AND (SLCT = MAXITEMS) THEN BEGVAL=BEGVAL+1:ENDVAL=ENDVAL+1:GOSUB FILL:RETURN
IF (SLCT > ENDVAL) AND (SLCT <> MAXITEMS) THEN BEGVAL=BEGVAL+1:ENDVAL=ENDVAL+1:GOSUB FILL:RETURN
GOSUB FILL:RETURN

'Process UP ARROW KeyPress

UP: IF ASC(RIGHT$(KP$,1))=72 THEN OLD=SLCT:SLCT=SLCT-1 ELSE GOTO PG.UP
IF SLCT < 1 THEN SLCT=1:SOUND 1000,1:SOUND 1500,2:SOUND 500,1
IF SLCT < BEGVAL AND SLCT = 1 THEN BEGVAL=BEGVAL-1:ENDVAL=ENDVAL-1:GOSUB FILL:RETURN
IF SLCT < BEGVAL AND SLCT <> 1 THEN BEGVAL=BEGVAL-1:ENDVAL=ENDVAL-1:GOSUB FILL:RETURN
GOSUB FILL:RETURN

'Process PAGE UP KeyPress

PG.UP: IF ASC(RIGHT$(KP$,1))=73 THEN OLD=SLCT:SLCT=SLCT-SHOWITEMS ELSE GOTO PG.DN
IF SLCT < 1 THEN SLCT=1:SOUND 1000,1:SOUND 1500,2:SOUND 500,1
BEGVAL=BEGVAL-SHOWITEMS:ENDVAL=ENDVAL-SHOWITEMS
IF BEGVAL < 1 THEN BEGVAL=1:ENDVAL=SHOWITEMS
GOSUB FILL:RETURN

'Process PAGE DOWN KeyPress

PG.DN: IF ASC(RIGHT$(KP$,1))=81 THEN OLD=SLCT:SLCT=SLCT+SHOWITEMS ELSE GOTO HOME
IF SLCT > MAXITEMS THEN SLCT=MAXITEMS:SOUND 1000,1:SOUND 1500,2:SOUND 500,1
BEGVAL=BEGVAL+SHOWITEMS:ENDVAL=ENDVAL+SHOWITEMS
IF ENDVAL > MAXITEMS THEN ENDVAL=MAXITEMS:BEGVAL=ENDVAL-SHOWITEMS+1
GOSUB FILL:RETURN

'Process HOME KeyPress

HOME: IF ASC(RIGHT$(KP$,1))=71 THEN OLD=SLCT:SLCT=1 ELSE GOTO ENDK
BEGVAL=1:ENDVAL=BEGVAL+SHOWITEMS-1
GOSUB FILL:RETURN

'Process END KeyPress

ENDK: IF ASC(RIGHT$(KP$,1))=79 THEN OLD=SLCT:SLCT=MAXITEMS ELSE GOTO ERRCHK
ENDVAL=MAXITEMS:BEGVAL=ENDVAL-SHOWITEMS+1
GOSUB FILL:RETURN

'Process ERROR

ERRCHK: SOUND 1000,1:SOUND 1500,2:SOUND 500,1:GOTO PRESS


'Fill Contents of window

FILL: K=1
IF BEGVAL < 1 THEN BEGVAL=1
IF ENDVAL > MAXITEMS THEN ENDVAL=MAXITEMS
OFFSET=ENDVAL-SLCT:IF OFFSET < 0 THEN OFFSET = 0 ELSE IF OFFSET > SHOWITEMS-1 THEN OFFSET = SHOWITEMS-1
FOR J=BEGVAL TO ENDVAL
ATTR=(BACK AND 7)*16+FORE
ROW=(ULR+1+K):COL=ULC
DAT$=ITEM$(J)
CALL FASTPRT(DAT$,ROW,COL,ATTR)
K=K+1
NEXT J
ATTR=(FORE AND 7)*16+BACK
IF BEGVAL=1 AND SLCT=1 THEN ROW=ULR+2 ELSE IF SLCT >= BEGVAL AND SLCT <= ENDVAL THEN ROW=ULR+2+SLCT
IF ENDVAL=MAXITEMS AND SLCT=MAXITEMS THEN ROW=LRR ELSE ROW=LRR-OFFSET
COL=ULC
DAT$=ITEM$(SLCT)
CALL FASTPRT(DAT$,ROW,COL,ATTR)
GOSUB MORE
RETURN

'Display arrowhead on top or bottom of window as necessary

MORE: MCOL=ULC+((LRC-ULC)/2)-1
IF BEGVAL > 1 THEN MROW=ULR+1:DAT$=" "+CHR$(30)+" ":GOSUB DISP
IF ENDVAL < MAXITEMS THEN MROW=LRR+1:DAT$=" "+CHR$(31)+" ":GOSUB DISP
IF SLCT = 1 THEN MROW=ULR+1:DAT$=STRING$(3,205):GOSUB DISP
IF SLCT = MAXITEMS THEN MROW=LRR+1:DAT$=STRING$(3,205):GOSUB DISP
RETURN

DISP: ATTR=(BACK AND 7)*16+FORE
CALL FASTPRT(DAT$,MROW,MCOL,ATTR)
RETURN

QUAD1: CROW=7
CCOL=20
RETURN
QUAD2: CROW=7
CCOL=60
RETURN
QUAD3: CROW=18
CCOL=60
RETURN
QUAD4: CROW=18
CCOL=20
RETURN

GETORD:

ULR=VAL(LEFT$(QUADRANT$,2))+1
ULC=VAL(RIGHT$(QUADRANT$,2))
LRR=ULR+SHOWITEMS+1
LRC=ULC+WINDLEN-1
RETURN

PUTHDR:

PAD=(WINDLEN/2)-(LEN(HEADER$)/2)-.5
MID$(TEMPHDR$,PAD+1,LEN(HEADER$))=HEADER$
HEADER$=TEMPHDR$
RETURN

DONE: END SUB