Category : BASIC Source Code
Archive   : QB_CODE.ZIP
Filename : MENUS.BAS

 
Output of file : MENUS.BAS contained in archive : QB_CODE.ZIP

'
' MENUS.BAS - For the QuickBASIC Toolbox
' Dialog-Box, Pop Up, and Pulldown Menu Routines
'

'
' $INCLUDE: 'TOOLBOX.BI'
'

DEFINT A-Z

DIM SHARED MENUATT, MENUHOTKEY, MENUHIGHLIGHT
DIM SHARED COLUMNS$, HOTKEYS$

FUNCTION DIALOG (ROW, COL, MENU() AS MENU, TITLE$())
SETMENUDEFAULTS
LMENU = LBOUND(MENU, 1)
UMENU = UBOUND(MENU, 1)
NMENU = UMENU - LMENU + 1
TABS$ = STRING$(NMENU, 0)
LTITLES = LBOUND(TITLE$, 1)
UTITLES = UBOUND(TITLE$, 1)
NTITLES = UTITLES - LTITLES + 1
GETCURPOS SROW, SCOL, I, IKEY
IF I < 32 THEN
FLAG = TRUE
LOCATE SROW, SCOL, 0
ELSE
FLAG = FALSE
END IF
FOR I = LTITLES TO UTITLES
IF LEN(TITLE$(I)) > MLEN THEN
MLEN = LEN(TITLE$(I))
END IF
NEXT I
CHLEN = NMENU - 1
FOR I = LMENU TO UMENU
CHLEN = CHLEN + RTLEN(MENU(I).ITEM) + 4
NEXT I
IF CHLEN > MLEN THEN
MLEN = CHLEN
END IF
ROW1 = ROW - (NTITLES + 7) \ 2
ROW2 = ROW1 + NTITLES + 6
COL1 = COL - (MLEN + 4) \ 2
COL2 = COL1 + MLEN + 3
WINDOW$ = OPENWINDOW$(ROW1, COL1, ROW2, COL2, MENUATT, SINGLELINE, MENUATT)
FOR I = LTITLES TO UTITLES
PRINTSTRING ROW1 + I + 1, COL - LEN(TITLE$(I)) \ 2, TITLE$(I)
NEXT I
J = COL - CHLEN \ 2
FOR I = LMENU TO UMENU
MID$(TABS$, I - LMENU + 1, 1) = CHR$(J)
IF I = LMENU THEN
DRAWBOX ROW2 - 3, J, ROW2 - 1, J + RTLEN(MENU(I).ITEM) + 3, DOUBLELINE, MENUATT
ELSE
DRAWBOX ROW2 - 3, J, ROW2 - 1, J + RTLEN(MENU(I).ITEM) + 3, SINGLELINE, MENUATT
END IF
HOTSTRING ROW2 - 2, J + 2, MENU(I).HOTKEY, MENUHOTKEY, RTRIM$(MENU(I).ITEM)
J = J + RTLEN(MENU(I).ITEM) + 5
NEXT I
SELECTION = 0
DO
IKEY = WAITKEY
IF IKEY = 13 THEN
IKEY = AMID(MENU(SELECTION + LMENU).ITEM, MENU(SELECTION + LMENU).HOTKEY)
END IF
SELECT CASE IKEY
CASE 331
IF NCHOICES <> 1 THEN
BCOL1 = AMID(TABS$, SELECTION + 1)
DRAWBOX ROW2 - 3, BCOL1, ROW2 - 1, BCOL1 + RTLEN(MENU(SELECTION + LMENU).ITEM) + 3, SINGLELINE, MENUATT
SELECTION = SELECTION - 1
IF SELECTION < 0 THEN
SELECTION = NMENU - 1
END IF
BCOL1 = AMID(TABS$, SELECTION + 1)
DRAWBOX ROW2 - 3, BCOL1, ROW2 - 1, BCOL1 + RTLEN(MENU(SELECTION + LMENU).ITEM) + 3, DOUBLELINE, MENUATT
END IF
CASE 333
IF NCHOICES <> 1 THEN
BCOL1 = AMID(TABS$, SELECTION + 1)
DRAWBOX ROW2 - 3, BCOL1, ROW2 - 1, BCOL1 + RTLEN(MENU(SELECTION + LMENU).ITEM) + 3, SINGLELINE, MENUATT
SELECTION = SELECTION + 1
IF SELECTION = NMENU THEN
SELECTION = 0
END IF
BCOL1 = AMID(TABS$, SELECTION + 1)
DRAWBOX ROW2 - 3, BCOL1, ROW2 - 1, BCOL1 + RTLEN(MENU(SELECTION + LMENU).ITEM) + 3, DOUBLELINE, MENUATT
END IF
CASE ELSE
IF IKEY > 31 AND IKEY < 128 THEN
FOR I = LMENU TO UMENU
IF UCASE$(CHR$(IKEY)) = UCASE$(CMID$(MENU(I).ITEM, MENU(I).HOTKEY)) THEN
WINDOW$ = CLOSEWINDOW$(WINDOW$)
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
DIALOG = I - LMENU + 1
EXIT FUNCTION
END IF
NEXT I
END IF
END SELECT
LOOP WHILE TRUE
END FUNCTION

SUB HOTSTRING (ROW, COL, HOTKEY, ATT, HSTRING$)
PRINTSTRING ROW, COL, HSTRING$
SETONE ROW, COL + HOTKEY - 1, ATT
END SUB

FUNCTION POPUP (ROW, COL1, MENU() AS MENU)
SETMENUDEFAULTS
LOWEST = LBOUND(MENU, 1)
HIGHEST = UBOUND(MENU, 1)
NUMBER = HIGHEST - LOWEST + 1
GETCURPOS SROW, SCOL, I, IKEY
IF I < 32 THEN
FLAG = TRUE
LOCATE SROW, SCOL, 0
ELSE
FLAG = FALSE
END IF
FOR I = LOWEST TO HIGHEST
IF RTLEN(MENU(I).ITEM) > MLEN THEN
MLEN = RTLEN(MENU(I).ITEM)
END IF
NEXT I
MLEN = MLEN + 4
COL2 = COL1 + MLEN - 1
WINDOW1$ = OPENWINDOW$(ROW, COL1, ROW + NUMBER + 1, COL2, MENUATT, SINGLELINE, MENUATT)
FOR I = LOWEST TO HIGHEST
HOTSTRING ROW + 1 + I - LOWEST, COL1 + 2, MENU(I).HOTKEY, MENUHOTKEY, RTRIM$(MENU(I).ITEM)
NEXT I
SELECTION = 0
DO
WINDOW2$ = OPENWINDOW$(ROW + 1 + SELECTION, COL1 + 1, ROW + 1 + SELECTION, COL2 - 1, 0, 0, 0)
SETATTRIB ROW + 1 + SELECTION, COL1 + 1, ROW + 1 + SELECTION, COL2 - 1, MENUHIGHLIGHT
IKEY = WAITKEY
IF IKEY = 13 THEN
IKEY = ASC(MID$(MENU(SELECTION + LOWEST).ITEM, MENU(SELECTION + LOWEST).HOTKEY, 1))
END IF
WINDOW2$ = CLOSEWINDOW$(WINDOW2$)
SELECT CASE IKEY
CASE 27
WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
POPUP = LOWEST - 1
EXIT FUNCTION
CASE 328
SELECTION = SELECTION - 1
IF SELECTION < 0 THEN
SELECTION = NUMBER - 1
END IF
CASE 336
SELECTION = SELECTION + 1
IF SELECTION = NUMBER THEN
SELECTION = 0
END IF
CASE ELSE
IF IKEY > 31 AND IKEY < 128 THEN
FOR I = LOWEST TO HIGHEST
IF UCASE$(CHR$(IKEY)) = UCASE$(MID$(MENU(I).ITEM, MENU(I).HOTKEY, 1)) THEN

WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
POPUP = I
EXIT FUNCTION
END IF
NEXT I
END IF
END SELECT
LOOP WHILE TRUE
END FUNCTION

FUNCTION PULLDOWN% (ROW, HEAD() AS MENUHEAD, MENU() AS MENU, IKEY)
ALTS$ = "QWERTYUIOPASDFGHJKLZXCVBNM"
SETMENUDEFAULTS
LHEAD = LBOUND(HEAD, 1)
UHEAD = UBOUND(HEAD, 1)
NHEAD = UHEAD - LHEAD + 1
LMENU = LBOUND(MENU, 1)
UMENU = UBOUND(MENU, 1)
NMENU = UMENU - LMENU + 1
GETCURPOS SROW, SCOL, I, PKEY
IF I < 32 THEN
FLAG = TRUE
ELSE
FLAG = FALSE
END IF
IF IKEY = 0 THEN
PKEY = WAITKEY
ELSE
PKEY = IKEY
END IF
SELECT CASE PKEY
CASE 272 TO 281
MENU = AMID(ALTS$, PKEY - 271)
CASE 286 TO 294
MENU = AMID(ALTS$, PKEY - 275)
CASE 300 TO 306
MENU = AMID(ALTS$, PKEY - 280)
CASE ELSE
PULLDOWN = PKEY
EXIT FUNCTION
END SELECT
MATCH = INSTR(HOTKEYS$, CHR$(MENU))
IF MATCH = 0 THEN
PULLDOWN = PKEY
EXIT FUNCTION
END IF
LOCATE SROW, SCOL, 0
MENU = MATCH
DO
MOFF = LMENU
FOR I = 1 TO MENU - 1
MOFF = MOFF + HEAD(LHEAD + I - 1).NUMITEMS
NEXT I
COL = AMID(COLUMNS$, MENU)
RCOL = RTLEN(HEAD(LHEAD + MENU - 1).ITEM)
FOR I = 1 TO HEAD(LHEAD + MENU - 1).NUMITEMS
IF RTLEN(MENU(MOFF + I - 1).ITEM) > RCOL THEN
RCOL = RTLEN(MENU(MOFF + I - 1).ITEM)
END IF
NEXT I
RCOL = RCOL + COL + 1
WINDOW1$ = OPENWINDOW$(ROW, COL - 2, ROW + 2 + HEAD(LHEAD + MENU - 1).NUMITEMS, RCOL, NODRAW, 0, 0)
DRAWWINDOW ROW + 1, COL - 2, ROW + 2 + HEAD(LHEAD + MENU - 1).NUMITEMS, RCOL, MENUATT, SINGLELINE, MENUATT
PRINTONE ROW, COL - 1, 179
PRINTONE ROW, COL + RTLEN(HEAD(LHEAD + MENU - 1).ITEM), 179
PRINTONE ROW + 1, COL - 1, 193
PRINTONE ROW + 1, COL + RTLEN(HEAD(LHEAD + MENU - 1).ITEM), 193
FOR I = 1 TO HEAD(LHEAD + MENU - 1).NUMITEMS
HOTSTRING ROW + I + 1, COL, MENU(MOFF + I - 1).HOTKEY, MENUHOTKEY, RTRIM$(MENU(MOFF + I - 1).ITEM)
NEXT I
SELECTION = 0
DO
WINDOW2$ = OPENWINDOW$(ROW + 2 + SELECTION, COL - 1, ROW + 2 + SELECTION, RCOL - 1, NODRAW, 0, 0)
SETATTRIB ROW + 2 + SELECTION, COL - 1, ROW + 2 + SELECTION, RCOL - 1, MENUHIGHLIGHT
IKEY = WAITKEY
IF IKEY = 13 THEN
IKEY = AMID(MENU(MOFF + SELECTION).ITEM, MENU(MOFF + SELECTION).HOTKEY)
END IF
WINDOW2$ = CLOSEWINDOW$(WINDOW2$)
SELECT CASE IKEY
CASE 27
WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
PULLDOWN = 0
EXIT FUNCTION
CASE 328
SELECTION = SELECTION - 1
IF SELECTION < 0 THEN
SELECTION = HEAD(LHEAD + MENU - 1).NUMITEMS - 1
END IF
CASE 331
WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
MENU = MENU - 1
IF MENU < 1 THEN
MENU = NHEAD
END IF
EXIT DO
CASE 333
WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
MENU = MENU + 1
IF MENU > NHEAD THEN
MENU = 1
END IF
EXIT DO
CASE 336
SELECTION = SELECTION + 1
IF SELECTION = HEAD(LHEAD + MENU - 1).NUMITEMS THEN
SELECTION = 0
END IF
CASE ELSE
IF IKEY > 31 AND IKEY < 128 THEN
FOR I = 0 TO HEAD(LHEAD + MENU - 1).NUMITEMS - 1
IF UCASE$(CHR$(IKEY)) = UCASE$(CMID$(MENU(MOFF + I).ITEM, MENU(MOFF + I).HOTKEY)) THEN
WINDOW1$ = CLOSEWINDOW$(WINDOW1$)
PULLDOWN = MOFF + I + 512
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
EXIT FUNCTION
END IF
NEXT I
END IF
END SELECT
LOOP WHILE TRUE
LOOP WHILE TRUE
END FUNCTION

SUB PULLDOWNBAR (ROW, HEAD() AS MENUHEAD)
SETMENUDEFAULTS
LHEAD = LBOUND(HEAD, 1)
UHEAD = UBOUND(HEAD, 1)
NHEAD = UHEAD - LHEAD + 1
COLUMNS$ = STRING$(NHEAD, 0)
HOTKEYS$ = COLUMNS$
GETCURPOS SROW, SCOL, I, COL
IF I < 32 THEN
FLAG = TRUE
LOCATE SROW, SCOL, 0
ELSE
FLAG = FALSE
END IF
FILLSCREEN ROW, 1, ROW, 80, 32, MENUATT
COL = 3
FOR I = 1 TO NHEAD
MID$(COLUMNS$, I, 1) = CHR$(COL)
MID$(HOTKEYS$, I, 1) = UCASE$(MID$(HEAD(LHEAD + I - 1).ITEM, HEAD(LHEAD + I - 1).HOTKEY, 1))
HOTSTRING ROW, COL, HEAD(LHEAD + I - 1).HOTKEY, MENUHOTKEY, RTRIM$(HEAD(LHEAD + I - 1).ITEM)
COL = COL + RTLEN(HEAD(LHEAD + I - 1).ITEM) + 2
NEXT I
IF FLAG THEN
LOCATE SROW, SCOL, 1
ELSE
LOCATE SROW, SCOL
END IF
END SUB

SUB SETMENUATT (ATT)
SETMENUDEFAULTS
MENUATT = ATT
END SUB

SUB SETMENUDEFAULTS
IF MENUATT = 0 AND MENUHOTKEY = 0 AND MENUHIGHLIGHT = 0 THEN
MENUATT = &H70
MENUHOTKEY = &H7F
MENUHIGHLIGHT = 7
END IF
END SUB

SUB SETMENUHIGHLIGHT (ATT)
SETMENUDEFAULTS
MENUHIGHLIGHT = ATT
END SUB

SUB SETMENUHOTKEY (ATT)
SETMENUDEFAULTS
MENUHOTKEY = ATT
END SUB