Category : BASIC Source Code
Archive   : PBC30B.ZIP
Filename : BARMENUM.BAS

' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1994 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+

DECLARE SUB AltKey (ASCIICode%, ScanCode%, Ky$)
DECLARE SUB CheckKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
DECLARE SUB GetMouseLoc (Row%, Column%)
DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
DECLARE SUB MMCursorOff ()
DECLARE SUB MMCursorOn ()
DECLARE SUB MouseBuffer (Bytes%)
DECLARE SUB MouseRest (St$)
DECLARE SUB MouseSave (St$)
DECLARE SUB ReColorArea (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)

SUB BarMenuM (PickList$(), Row%, LCol%, RCol%, Attr%, HiAttr%, PromptSt$, Mouse%, ShowCursor%)

L% = LBOUND(PickList$) - 1

Choices% = 0
FOR tmp% = LBOUND(PickList$) TO UBOUND(PickList$)
IF LEN(PickList$(tmp%)) THEN
Choices% = Choices% + 1
ELSE
EXIT FOR
END IF
NEXT
IF Choices% = 0 THEN
Row% = 0
EXIT SUB
END IF

DIM Posn%(1 TO Choices%)

GetVidMode BIOSMode%, ScreenWidth%, Page%

IF Row% = 0 THEN Row% = 1

IF LCol% THEN
LeftCol% = LCol%
ELSE
LeftCol% = 1
END IF

IF RCol% THEN
RightCol% = RCol%
ELSE
RightCol% = ScreenWidth%
END IF

IF LEN(PromptSt$) THEN
Prompt$ = PromptSt$
ELSE
Prompt$ = " "
END IF

Place% = 1

BarPlace% = LeftCol% + LEN(Prompt$)
FOR tmp% = 1 TO Choices%
Posn%(tmp%) = BarPlace%
st$ = PickList$(L% + tmp%)
Bar$ = Bar$ + " " + st$ + " "
BarPlace% = BarPlace% + LEN(st$) + 2
ok% = 0
DO UNTIL ok% OR LEN(st$) = 0
ch$ = LEFT$(st$, 1)
ok% = (ch$ > " " AND ch$ < "a" OR ch$ > "z")
st$ = MID$(st$, 2)
LOOP
IF ok% THEN
KeyList$ = KeyList$ + ch$
ELSE
KeyList$ = KeyList$ + UCASE$(LEFT$(PickList$(L% + tmp%), 1))
END IF
NEXT
IF RightCol% < 1 THEN RightCol% = BarPlace%
IF RightCol% > ScreenWidth% THEN RightCol% = ScreenWidth%
Bar$ = LEFT$(Prompt$ + Bar$ + SPACE$(ScreenWidth%), RightCol% - LeftCol% + 1)

IF Mouse% THEN
MouseBuffer Bytes% ' save mouse state
OldMouse$ = SPACE$(Bytes%)
MouseSave OldMouse$
END IF

IF Mouse% THEN MMCursorOff
XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%

CheckKey Mouse%, AscCode%, ScanCode%, LeftB%, RightB% ' clear mouse buttons

DO
IF Mouse% THEN MMCursorOn
GetKey Mouse%, AscCode%, ScanCode%, LeftB%, RightB%
IF LeftB% THEN
GetMouseLoc R%, C%
IF R% = Row% THEN
tmp% = 1
found% = 0
DO WHILE tmp% <= Choices% AND NOT found%
IF C% >= Posn%(tmp%) AND C% <= Posn%(tmp%) + LEN(PickList$(L% + tmp%)) + 1 THEN
found% = -1
ELSE
tmp% = tmp% + 1
END IF
LOOP
IF found% THEN
Place% = tmp%
AscCode% = 13
Done% = -1
END IF
END IF
ELSEIF RightB% THEN
AscCode% = 27
Done% = -1
ELSEIF AscCode% = 8 OR AscCode% = 0 AND (ScanCode% = 15 OR ScanCode% = 75) THEN
' *** backspace, backtab, left arrow ***
IF Place% = 1 THEN
Place% = Choices%
ELSE
Place% = Place% - 1
END IF
ELSEIF AscCode% = 32 OR AscCode% = 9 OR AscCode% = 0 AND ScanCode% = 77 THEN
' *** space, tab, right arrow ***
IF Place% = Choices% THEN
Place% = 1
ELSE
Place% = Place% + 1
END IF
ELSEIF AscCode% = 13 OR AscCode% = 27 THEN
' *** , ***
Done% = -1
ELSE
' *** anything else... check to see if it's a menu selection ***
IF AscCode% > 32 THEN
ch$ = UCASE$(CHR$(AscCode%))
ELSE
AltKey AscCode%, ScanCode%, ch$
END IF
IF LEN(ch$) THEN
tmp% = INSTR(KeyList$, ch$)
IF tmp% THEN
Place% = tmp%
Done% = -1
END IF
END IF
END IF
IF Mouse% THEN MMCursorOff
XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%
LOOP UNTIL Done%

IF AscCode% = 27 THEN
Row% = 0
ELSE
Row% = Place%
END IF

IF Mouse% THEN MouseRest OldMouse$ ' restore mouse state
END SUB