Posts: 53
Threads: 11
Joined: Jun 2024
Reputation:
3
Hello,
In the QB64 help section I found the "inkeymenu" example.
This gave me the idea to create the simplest possible function to select an item from an array "ListArray"
When this worked, I recreated it for use as a "simplemenu" function.
To improve readability, I:
- Used "Select case..." instead of "IF THEN ELSE..."
- Created constant names for the control keys.
Regards, Rudy
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%) :
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM TestArray$(62)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill TestArray$().
'==================
FOR x% = 1 TO 62
SELECT CASE x%
CASE 1 TO 26
'alfabet lower case
TestArray$(x%) = STRING$(70, CHR$(x% + 96))
CASE 27 TO 52
'alfabet upper case
TestArray$(x%) = STRING$(70, CHR$(x% + 38))
CASE 53 TO 62
'numbers 0 to 9 converted to string
TestArray$(x%) = STRING$(70, LTRIM$(STR$(x% - 53)))
END SELECT
NEXT x%
Choice% = ListArray%(TestArray$(), 70, 10)
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Record:"; Choice%
SLEEP
END
'============================================================
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%)
DIM k% 'ASC number of pressed key
DIM k$ 'character via inkey$
DIM x% 'general counter
'List variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' the selected listitem
DIM Column%
DIM FirstListItem%
DIM Focus% ' current selected list-item
DIM ListItem% ' generic counter
'DIM MaxListItems% ' Maximum number listitems to display on screen
ArrayLB% = LBOUND(ShowArray$): ArrayUB% = UBOUND(ShowArray$)
ArrayLB% = ArrayLB% + 1: 'I preserve Array(0) to use for headerfile info or version info of datafile
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
SELECT CASE ListWidth%
CASE IS = 0
ListWidth% = 1
CASE IS > 70
ListWidth% = 70
END SELECT
Column% = ((80 - ListWidth%) / 2) - 2 'list in the midle of the screen (-2 for PRINT USING "####")
IF MaxListItems% = 0 THEN
MaxListItems% = 10 'Minimum 1 listitem or Maximum 20 listitems with fullscreen...
END IF
LOCATE 1, Column% + 20
COLOR 15, 1
PRINT "Move with arrowkeys and make Your Choice:"
LOCATE 2, 5
PRINT "<UP><DOWN><PGUP><PGDN><HOME><END> <ENTER> = Select <ESC> = no choice"
DO '
'Display items
FOR ListItem% = 1 TO MaxListItems%
LOCATE ListItem% + 3, Column% ' start position screenlist
IF Focus% = ListItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "####"; (ArrayStartItem% + ListItem% - 1); ' display recordnr
PRINT " "; LEFT$(ShowArray$(ArrayStartItem% + ListItem% - 1), ListWidth%) ' display listitems
NEXT ListItem%
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC>: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxListItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxListItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE PGUP
SELECT CASE ArrayStartItem%
CASE IS >= MaxListItems%
'move MaxListItems% upwards
ArrayStartItem% = ArrayStartItem% - MaxListItems%
Focus% = 1
CASE ELSE
'Move to first arrayitem
ArrayStartItem% = 1
Focus% = 1
END SELECT
'END IF
CASE PGDOWN
SELECT CASE ArrayStartItem% + MaxListItems%
CASE IS < ArrayUB% - MaxListItems%
'move MaxListItems% down
ArrayStartItem% = ArrayStartItem% + MaxListItems%
Focus% = 1
CASE ELSE
'Show the last number of MaxListItems%
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = MaxListItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
ListArray% = Choice%
END FUNCTION 'ListArray --------------------------
'===============================================================================
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$):
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM Menu1Names$(7)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill MenuNames$().
'==================
FOR x% = 1 TO UBOUND(Menu1Names$)
Menu1Names$(x%) = "Menu"
NEXT x%
'Test long menu item:
'Menu1Names$(5) = "Menuxxxxxxxxxxxxxxxxxx"
Choice% = SimpelMenu%(Menu1Names$(), "R")
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Menu nr:"; Choice%
SLEEP
END
'============================================================
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$)
'Output: SimpelMenu% = Choice%
'Based on ListArray (itself based on InkeyMenu (QB64 help section)
'Possible extensions:
'-Draw frame around menu
'-Using the mouse
'-Exitkey%
'etc...
DIM k$ 'character via inkey$
DIM k% 'ASC number of pressed key
DIM x% 'general counter
'Menu variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' Selected Menuitem
DIM Column%
DIM FirstMenuItem%
DIM Focus% ' Current selected Menu-item
DIM LongestMenuItem%
DIM MaxMenuItems% ' Maximum number Menuitems to display on screen
DIM MenuItem% ' Generic counter
DIM MenuWidth%
ArrayLB% = LBOUND(MenuItems$): ArrayUB% = UBOUND(MenuItems$)
ArrayLB% = ArrayLB% + 1 'here we do'nt use array(0)...
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
FOR x% = ArrayLB% TO ArrayUB%
IF LongestMenuItem% < LEN(MenuItems$(x%)) THEN
LongestMenuItem% = LEN(MenuItems$(x%))
END IF
NEXT x%
MaxMenuItems% = ArrayUB%
SELECT CASE UCASE$(LeftMiddleRight$)
CASE "L" ' Left on the screen
Column% = 2
CASE "R" ' Right on the screen
Column% = 80 - LongestMenuItem% - 4
CASE ELSE ' Middle of the screen
Column% = 40 - LongestMenuItem% / 2 '(+- in the middle of the screen)
END SELECT
LOCATE 1, 20
COLOR 15, 1
PRINT "Move with arrowkeys and make Your Choice:"
LOCATE 2, 8
PRINT "<UP> <DOWN> <HOME> <END> <ENTER> = Select <ESC> = no choice"
DO '
'Display items
FOR MenuItem% = 1 TO MaxMenuItems%
LOCATE MenuItem% + 3, Column% ' start position screenMenu
IF Focus% = MenuItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "##"; MenuItem%;
PRINT " "; MenuItems$(ArrayStartItem% + MenuItem% - 1) ' display Menuitems
NEXT MenuItem%
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC> key: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxMenuItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxMenuItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxMenuItems% + 1
Focus% = MaxMenuItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
SimpelMenu% = Choice%
END FUNCTION 'MenuArray --------------------------
Posts: 53
Threads: 11
Joined: Jun 2024
Reputation:
3
Hello again,
I added a small "Drawbox" subroutine to both routines to draw a box around the list or menu.
The box is double-lined but can be further expanded with chr$(208), chr$(209), or chr$(210) if desired.
Regards,
Rudy
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%) + sub Drawbox
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM TestArray$(62)
_FULLSCREEN
SCREEN 0
'SCREEN 12
COLOR , 1
CLS
'Fill TestArray$().
'==================
FOR x% = 1 TO 62
SELECT CASE x%
CASE 1 TO 26
'alfabet lower case
TestArray$(x%) = STRING$(70, CHR$(x% + 96))
CASE 27 TO 52
'alfabet upper case
TestArray$(x%) = STRING$(70, CHR$(x% + 38))
CASE 53 TO 62
'numbers 0 to 9 converted to string
TestArray$(x%) = STRING$(70, LTRIM$(STR$(x% - 53)))
END SELECT
NEXT x%
Choice% = ListArray%(TestArray$(), 70, 20)
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Record:"; Choice%
SLEEP
END
'============================================================
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%)
'List 2 items till 20 items of an array without using array(0)
'Return: array-indexnumber, no choice then return = 0
DIM k% 'ASC number of pressed key
DIM k$ 'character via inkey$
DIM x% 'general counter
DIM x1%, x2%, y1%, y2% 'to draw a box
'List variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' the selected listitem
DIM Column%
DIM FirstListItem%
DIM Focus% ' current selected list-item
DIM ListItem% ' generic counter
'DIM MaxListItems% ' Maximum number listitems to display on screen
ArrayLB% = LBOUND(ShowArray$): ArrayUB% = UBOUND(ShowArray$)
ArrayLB% = ArrayLB% + 1: 'I preserve Array(0) to use for headerfile info or version info of datafile
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
SELECT CASE ListWidth%
CASE IS = 0
ListWidth% = 1
CASE IS > 70
ListWidth% = 70
END SELECT
Column% = ((80 - ListWidth%) / 2) - 2 'list in the midle of the screen (-2 for PRINT USING "####")
IF MaxListItems% = 0 THEN
MaxListItems% = 10 'Minimum 1 listitem or Maximum 20 listitems with fullscreen...
END IF
x1% = 1: y1% = 2: x2% = x1% + MaxListItems% + 2: y2% = y1% + ListWidth% + 5
CALL DrawBox(x1%, y1%, x2%, y2%)
LOCATE 2, 4
PRINT " Move keys: UP DOWN PGUP PGDN HOME END ENTER = Select ESC = no choice "
DO '
'Display items
FOR ListItem% = 1 TO MaxListItems%
LOCATE ListItem% + 2, Column% ' start position screenlist
IF Focus% = ListItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "####"; (ArrayStartItem% + ListItem% - 1); ' display recordnr
PRINT " "; LEFT$(ShowArray$(ArrayStartItem% + ListItem% - 1), ListWidth%) ' display listitems
NEXT ListItem%
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC>: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxListItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxListItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE PGUP
SELECT CASE ArrayStartItem%
CASE IS >= MaxListItems%
'move MaxListItems% upwards
ArrayStartItem% = ArrayStartItem% - MaxListItems%
Focus% = 1
CASE ELSE
'Move to first arrayitem
ArrayStartItem% = 1
Focus% = 1
END SELECT
'END IF
CASE PGDOWN
SELECT CASE ArrayStartItem% + MaxListItems%
CASE IS < ArrayUB% - MaxListItems%
'move MaxListItems% down
ArrayStartItem% = ArrayStartItem% + MaxListItems%
Focus% = 1
CASE ELSE
'Show the last number of MaxListItems%
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = MaxListItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
ListArray% = Choice%
END FUNCTION 'ListArray --------------------------
'===========================================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%)
'Draws a double lined box
'Input: leftuppercorner and right undercoren coordinates
'Possible extention: +1 extra inputvariabel to also use of chr$ 208 209 or 210 (blocks)
DIM x%
'The CHR$ codes are the extended character codes
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SUB
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$) + sub Drawbox
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM Menu1Names$(7)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill MenuNames$().
'==================
FOR x% = 1 TO UBOUND(Menu1Names$)
Menu1Names$(x%) = "Menu"
NEXT x%
'Test long menu item:
'Menu1Names$(5) = "Menuxxxxxxxxxxxxxxxxxx"
Choice% = SimpelMenu%(Menu1Names$(), "M")
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Menu nr:"; Choice%
SLEEP
END
'============================================================
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$)
'Output: SimpelMenu% = Choice%
'Based on ListArray (itself based on InkeyMenu (QB64 help section)
'Possible extensions:
'-Draw frame around menu
'-Using the mouse
'-Exitkey%
'etc...
DIM k$ 'character via inkey$
DIM k% 'ASC number of pressed key
DIM x% 'general counter
DIM x1%, x2%, y1%, y2%
'Menu variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' Selected Menuitem
DIM Column%
DIM FirstMenuItem%
DIM Focus% ' Current selected Menu-item
DIM LongestMenuItem%
DIM MaxMenuItems% ' Maximum number Menuitems to display on screen
DIM MenuItem% ' Generic counter
DIM MenuWidth%
ArrayLB% = LBOUND(MenuItems$): ArrayUB% = UBOUND(MenuItems$)
ArrayLB% = ArrayLB% + 1 'here we do'nt use array(0)...
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
FOR x% = ArrayLB% TO ArrayUB%
IF LongestMenuItem% < LEN(MenuItems$(x%)) THEN
LongestMenuItem% = LEN(MenuItems$(x%))
END IF
NEXT x%
MaxMenuItems% = ArrayUB%
SELECT CASE UCASE$(LeftMiddleRight$)
CASE "L" ' Left on the screen
Column% = 4
CASE "R" ' Right on the screen
Column% = 80 - LongestMenuItem% - 6
CASE ELSE ' Middle of the screen
Column% = 40 - LongestMenuItem% / 2 '(+- in the middle of the screen)
END SELECT
x1% = MenuItem% + 3
y1% = Column% - 1
x2% = x1% + MaxMenuItems% + 1
y2% = y1% + LongestMenuItem% + 4
LOCATE 1, 20
COLOR 15, 1
PRINT "Move with arrowkeys and make Your Choice:"
LOCATE 2, 8
PRINT "<UP> <DOWN> <HOME> <END> <ENTER> = Select <ESC> = no choice"
DO '
'Display items
FOR MenuItem% = 1 TO MaxMenuItems%
LOCATE MenuItem% + 3, Column% ' start position screenMenu
IF Focus% = MenuItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "##"; MenuItem%;
PRINT " "; MenuItems$(ArrayStartItem% + MenuItem% - 1) ' display Menuitems
NEXT MenuItem%
CALL DrawBox(x1%, y1%, x2%, y2%)
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC> key: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxMenuItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxMenuItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxMenuItems% + 1
Focus% = MaxMenuItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
SimpelMenu% = Choice%
END FUNCTION 'MenuArray --------------------------
'=========================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%)
DIM x%
'The CHR$ codes are the extended character codes
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SUB
Posts: 53
Threads: 11
Joined: Jun 2024
Reputation:
3
Hello again,
I've further expanded the two functions. In the Drawbox subset, I've used the " old-fashioned" mbasic qbasic characters to frame a menu (chr$ 176 177 178). The drawframe routine has been expanded for this purpose with a single variable, "frame%."
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM TestArray$(62)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill TestArray$().
'==================
FOR x% = 1 TO 62
SELECT CASE x%
CASE 1 TO 26
'alfabet lower case
TestArray$(x%) = STRING$(70, CHR$(x% + 96))
CASE 27 TO 52
'alfabet upper case
TestArray$(x%) = STRING$(70, CHR$(x% + 38))
CASE 53 TO 62
'numbers 0 to 9 converted to string
TestArray$(x%) = STRING$(70, LTRIM$(STR$(x% - 53)))
END SELECT
NEXT x%
Choice% = ListArray%(TestArray$(), 70, 20)
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Record:"; Choice%
SLEEP
END
'============================================================
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%)
'List 2 items till 20 items of an array without using array(0)
'Return: array-indexnumber, no choice then return = 0
DIM k% 'ASC number of pressed key
DIM k$ 'character via inkey$
DIM x% 'general counter
DIM x1%, x2%, y1%, y2%, frame% 'to draw a box
'List variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' the selected listitem
DIM Column%
DIM FirstListItem%
DIM Focus% ' current selected list-item
DIM ListItem% ' generic counter
'DIM MaxListItems% ' Maximum number listitems to display on screen
ArrayLB% = LBOUND(ShowArray$): ArrayUB% = UBOUND(ShowArray$)
ArrayLB% = ArrayLB% + 1: 'I preserve Array(0) to use for headerfile info or version info of datafile
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
SELECT CASE ListWidth%
CASE IS = 0
ListWidth% = 1
CASE IS > 70
ListWidth% = 70
END SELECT
Column% = ((80 - ListWidth%) / 2) - 2 'list in the midle of the screen (-2 for PRINT USING "####")
IF MaxListItems% = 0 THEN
MaxListItems% = 10 'Minimum 1 listitem or Maximum 20 listitems with fullscreen...
END IF
x1% = 1: y1% = 2: x2% = x1% + MaxListItems% + 2: y2% = y1% + ListWidth% + 5
frame% = 178 '0 or... 176 177 178
CALL DrawBox(x1%, y1%, x2%, y2%, frame%)
LOCATE 2, 4
PRINT " Move keys: UP DOWN PGUP PGDN HOME END ENTER = Select ESC = no choice "
DO '
'Display items
FOR ListItem% = 1 TO MaxListItems%
LOCATE ListItem% + 2, Column% ' start position screenlist
IF Focus% = ListItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "####"; (ArrayStartItem% + ListItem% - 1); ' display recordnr
PRINT " "; LEFT$(ShowArray$(ArrayStartItem% + ListItem% - 1), ListWidth%) ' display listitems
NEXT ListItem%
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC>: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxListItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxListItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE PGUP
SELECT CASE ArrayStartItem%
CASE IS >= MaxListItems%
'move MaxListItems% upwards
ArrayStartItem% = ArrayStartItem% - MaxListItems%
Focus% = 1
CASE ELSE
'Move to first arrayitem
ArrayStartItem% = 1
Focus% = 1
END SELECT
'END IF
CASE PGDOWN
SELECT CASE ArrayStartItem% + MaxListItems%
CASE IS < ArrayUB% - MaxListItems%
'move MaxListItems% down
ArrayStartItem% = ArrayStartItem% + MaxListItems%
Focus% = 1
CASE ELSE
'Show the last number of MaxListItems%
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = MaxListItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
ListArray% = Choice%
END FUNCTION 'ListArray --------------------------
'===========================================
'=========================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%, Frame%)
DIM x%
'The CHR$ codes are the extended character codes
SELECT CASE Frame%
CASE 176, 177, 178
LOCATE XPos1%, YPos1%
PRINT CHR$(Frame%); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(Frame%));
PRINT CHR$(Frame%); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(Frame%)
LOCATE x%, YPos2% + 1: PRINT CHR$(Frame%)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(Frame%); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(Frame%));
PRINT CHR$(Frame%) 'right under corner
CASE ELSE 'Make double line frames
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SELECT
END SUB 'DrawBox
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM Menu1Names$(10)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill MenuNames$().
'==================
FOR x% = 1 TO UBOUND(Menu1Names$)
Menu1Names$(x%) = "Menu" + STR$(x%)
NEXT x%
'Test long menu item:
'Menu1Names$(5) = "Menuxxxxxxxxxxxxxxxxxx"
Choice% = SimpelMenu%(Menu1Names$(), "M")
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Menu nr:"; Choice%
SLEEP
END
'============================================================
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$)
'Output: SimpelMenu% = Choice%
'Based on ListArray (itself based on InkeyMenu (QB64 help section)
'Possible extensions:
'-Draw frame around menu
'-Using the mouse
'-Exitkey%
'etc...
DIM k$ 'character via inkey$
DIM k% 'ASC number of pressed key
DIM x% 'general counter
DIM x1%, x2%, y1%, y2%
'Menu variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' Selected Menuitem
DIM Column%
DIM FirstMenuItem%
DIM Focus% ' Current selected Menu-item
DIM Frame%
DIM LongestMenuItem%
DIM MaxMenuItems% ' Maximum number Menuitems to display on screen
DIM MenuItem% ' Generic counter
DIM MenuWidth%
ArrayLB% = LBOUND(MenuItems$): ArrayUB% = UBOUND(MenuItems$)
ArrayLB% = ArrayLB% + 1 'here we do'nt use array(0)...
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
FOR x% = ArrayLB% TO ArrayUB%
IF LongestMenuItem% < LEN(MenuItems$(x%)) THEN
LongestMenuItem% = LEN(MenuItems$(x%))
END IF
NEXT x%
MaxMenuItems% = ArrayUB%
SELECT CASE UCASE$(LeftMiddleRight$)
CASE "L" ' Left on the screen
Column% = 4
CASE "R" ' Right on the screen
Column% = 80 - LongestMenuItem% - 6
CASE ELSE ' Middle of the screen
Column% = 40 - LongestMenuItem% / 2 '(+- in the middle of the screen)
END SELECT
x1% = MenuItem% + 3
y1% = Column% - 1
x2% = x1% + MaxMenuItems% + 1
y2% = y1% + LongestMenuItem% + 2
LOCATE 1, 20
COLOR 15, 1
PRINT "Move with arrowkeys and make Your Choice:"
LOCATE 2, 8
PRINT "<UP> <DOWN> <HOME> <END> <ENTER> = Select <ESC> = no choice"
DO '
'Display items
FOR MenuItem% = 1 TO MaxMenuItems%
LOCATE MenuItem% + 3, Column% ' start position screenMenu
IF Focus% = MenuItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
'PRINT USING "##"; MenuItem%;
PRINT " "; MenuItems$(ArrayStartItem% + MenuItem% - 1) ' display Menuitems
NEXT MenuItem%
'Frame% = 176, 177, 178
Frame% = 176
CALL DrawBox(x1%, y1%, x2%, y2%, Frame%)
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC> key: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxMenuItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxMenuItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxMenuItems% + 1
Focus% = MaxMenuItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
SimpelMenu% = Choice%
END FUNCTION 'MenuArray --------------------------
'=========================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%, Frame%)
DIM x%
'The CHR$ codes are the extended character codes
SELECT CASE Frame%
CASE 176, 177, 178
LOCATE XPos1%, YPos1%
PRINT CHR$(Frame%); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(Frame%));
PRINT CHR$(Frame%); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(Frame%)
LOCATE x%, YPos2% + 1: PRINT CHR$(Frame%)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(Frame%); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(Frame%));
PRINT CHR$(Frame%) 'right under corner
CASE ELSE 'Make double line frames
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SELECT
END SUB 'DrawBox
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
Hi @Rudy M
Just tested your code for a popup as not terribly bulkly for a quick menu. I recommend a double line frame as opposed to the dotted one you are using for an Ascii border. As I recall the double frame is code symbol for a dialog that must be answered before execution can continue, early Windows and VB days. Also the color bright green is so close to yellow that it's hard for me and maybe others with a little color blindness to greens to distinguish, I recommend color opposites like Purple to Yellow, Green to Red, Blue to Oranage... Just some suggestions. 
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 53
Threads: 11
Joined: Jun 2024
Reputation:
3
@bplus: Thank you for your valid comment.
I was seduced by the nostalgia of the "speckled blocks."
But 'its old-fashioned', so:
I modified both programs and now have a single-line or double-line frame.
The "Frame%" parameter is now also included when calling the two functions.
Regarding the colors, thanks for Your hints!
I also created a small program to demonstrate the basic colors on the screen, along with their numbers.
Reason:
I had four eye surgeries in 2025, and despite this, I am completely blind in my right eye. Good news, my left eye is 100%. But... as a side effect, I have become very sensitive to light.
So, I program in QB64 using "dark themes. "Blinking" text is painful and unbearable for me.
But for my own programs, I also provide dark themes that are still functional or acceptable for my partner and friends.
I'll add the little color testlisting below as the third program.
Best regards, and happy holidays.
Rudy M
Listarray function with single and double lined borders + frame% parameter included in function:
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
'Idem for colors:
CONST BLUE = 1, GREEN = 10, YELLOW = 14, WHITE = 15
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM TestArray$(62)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill TestArray$().
'==================
FOR x% = 1 TO 62
SELECT CASE x%
CASE 1 TO 26
'alfabet lower case
TestArray$(x%) = STRING$(70, CHR$(x% + 96))
CASE 27 TO 52
'alfabet upper case
TestArray$(x%) = STRING$(70, CHR$(x% + 38))
CASE 53 TO 62
'numbers 0 to 9 converted to string
TestArray$(x%) = STRING$(70, LTRIM$(STR$(x% - 53)))
END SELECT
NEXT x%
Choice% = ListArray%(TestArray$(), 70, 20, 1)
CLS
LOCATE 18, 2
COLOR WHITE, BLUE ' white on blue
PRINT "You chose Record:"; Choice%
SLEEP
END
'============================================================
FUNCTION ListArray% (ShowArray$(), ListWidth%, MaxListItems%, Frame%)
'List 1 item till maximum 20 listitems of an array without using array(0)
'Return: array-indexnumber, no choice then return = 0
'Frame = 1: Make single line frame, = 2 or another value: make alwas double line border
DIM k% 'ASC number of pressed key
DIM k$ 'character via inkey$
DIM x% 'general counter
DIM x1%, x2%, y1%, y2% 'to draw a box parameters
'List variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' the selected listitem
DIM Column%
DIM FirstListItem%
DIM Focus% ' current selected list-item
DIM ListItem% ' generic counter
'DIM MaxListItems% ' Maximum number listitems to display on screen
ArrayLB% = LBOUND(ShowArray$): ArrayUB% = UBOUND(ShowArray$)
ArrayLB% = ArrayLB% + 1: 'I preserve Array(0) to use for headerfile info or version info of datafile
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
SELECT CASE ListWidth%
CASE IS = 0
ListWidth% = 1 'to see something...
CASE IS > 70
ListWidth% = 70
END SELECT
Column% = ((80 - ListWidth%) / 2) - 2 'list in the midle of the screen (-2 places for PRINT USING "####")
IF MaxListItems% = 0 THEN
MaxListItems% = 1 ' Minimum 1 listitem
ELSEIF MaxListItems% > 20 THEN
MaxListItems% = 20 ' Maximum 20 listitems with fullscreen...
END IF
x1% = 1: y1% = 2: x2% = x1% + MaxListItems% + 2: y2% = y1% + ListWidth% + 5
'Frame% = 0 '0 = double lined else... single line border
CALL DrawBox(x1%, y1%, x2%, y2%, Frame%)
LOCATE 2, 4
PRINT " Move keys: UP DOWN PGUP PGDN HOME END ENTER = Select ESC = no choice "
DO '
'Display items
FOR ListItem% = 1 TO MaxListItems%
LOCATE ListItem% + 2, Column% ' start position screenlist
IF Focus% = ListItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
PRINT USING "####"; (ArrayStartItem% + ListItem% - 1); ' display recordnr
PRINT " "; LEFT$(ShowArray$(ArrayStartItem% + ListItem% - 1), ListWidth%) ' display listitems
NEXT ListItem%
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' ´ normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC>: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxListItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxListItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE PGUP
SELECT CASE ArrayStartItem%
CASE IS >= MaxListItems%
'move MaxListItems% upwards
ArrayStartItem% = ArrayStartItem% - MaxListItems%
Focus% = 1
CASE ELSE
'Move to first arrayitem
ArrayStartItem% = 1
Focus% = 1
END SELECT
'END IF
CASE PGDOWN
SELECT CASE ArrayStartItem% + MaxListItems%
CASE IS < ArrayUB% - MaxListItems%
'move MaxListItems% down
ArrayStartItem% = ArrayStartItem% + MaxListItems%
Focus% = 1
CASE ELSE
'Show the last number of MaxListItems%
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxListItems% + 1
Focus% = MaxListItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
ListArray% = Choice%
END FUNCTION 'ListArray --------------------------
'===================================================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%, Frame%)
DIM x%
'The CHR$ codes are the extended character codes
SELECT CASE Frame%
CASE 1 'Single line frame
LOCATE XPos1%, YPos1%
PRINT CHR$(218); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(196));
PRINT CHR$(191); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(179)
LOCATE x%, YPos2% + 1: PRINT CHR$(179)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(192); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(196));
PRINT CHR$(217) 'right under corner
CASE ELSE 'Else always make double line frame
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SELECT
END SUB 'DrawBox --------------------------------------------------
Simplemenu function with single and double lined borders + frame% parameter included in function:
Code: (Select All)
OPTION _EXPLICIT
'--------------------------------------
'Give some keys "Constantnames" to improve readability
CONST ESC = 27, ENTER = 13
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77, PGUP = 73, PGDOWN = 81, HOMEKEY = 71, ENDKEY = 79
DIM Choice%
DIM x% ' general counter
'TestArray%
DIM Menu1Names$(10)
_FULLSCREEN
SCREEN 0
COLOR , 1
CLS
'Fill MenuNames$().
'==================
FOR x% = 1 TO UBOUND(Menu1Names$)
Menu1Names$(x%) = "Menu" + STR$(x%)
NEXT x%
'Test long menu item:
'Menu1Names$(5) = "Menuxxxxxxxxxxxxxxxxxx"
Choice% = SimpelMenu%(Menu1Names$(), "M", 1)
CLS
LOCATE 18, 2
COLOR 15, 1 ' white on blue
PRINT "You chose Menu nr:"; Choice%
SLEEP
END
'============================================================
FUNCTION SimpelMenu% (MenuItems$(), LeftMiddleRight$, Frame%)
'MenuItem$() = Text array with menu-items
'LeftMiddleRight$ = L or =M or = R to print Simpelmenu Left, Middle or Right on the screen
'Frame% = 1 : Single line border
'Frame% = 2 or any other value: Double line border
'Output: SimpelMenu% = Choice%
'Based on ListArray (itself based on InkeyMenu (QB64 help section)
'Possible extensions:
'-Using the mouse
'-Exitkey%
'etc...
DIM k$ 'character via inkey$
DIM k% 'ASC number of pressed key
DIM x% 'general counter
DIM x1%, x2%, y1%, y2%
'Menu variables
DIM ArrayLB%
DIM ArrayUB%
DIM ArrayStartItem%
DIM Choice% ' Selected Menuitem
DIM Column%
DIM FirstMenuItem%
DIM Focus% ' Current selected Menu-item
DIM LongestMenuItem%
DIM MaxMenuItems% ' Maximum number Menuitems to display on screen
DIM MenuItem% ' Generic counter
DIM MenuWidth%
ArrayLB% = LBOUND(MenuItems$): ArrayUB% = UBOUND(MenuItems$)
ArrayLB% = ArrayLB% + 1 'here we do'nt use array(0)...
ArrayStartItem% = 1
Choice% = 0
Focus% = 1
FOR x% = ArrayLB% TO ArrayUB%
IF LongestMenuItem% < LEN(MenuItems$(x%)) THEN
LongestMenuItem% = LEN(MenuItems$(x%))
END IF
NEXT x%
MaxMenuItems% = ArrayUB%
SELECT CASE UCASE$(LeftMiddleRight$)
CASE "L" ' Left on the screen
Column% = 4
CASE "R" ' Right on the screen
Column% = 80 - LongestMenuItem% - 6
CASE ELSE ' Middle of the screen
Column% = 40 - LongestMenuItem% / 2 '(+- in the middle of the screen)
END SELECT
x1% = MenuItem% + 3
y1% = Column% - 1
x2% = x1% + MaxMenuItems% + 1
y2% = y1% + LongestMenuItem% + 2
LOCATE 1, 20
COLOR 15, 1
PRINT "Move with arrowkeys and make Your Choice:"
LOCATE 2, 8
PRINT "<UP> <DOWN> <HOME> <END> <ENTER> = Select <ESC> = no choice"
DO '
'Display items
FOR MenuItem% = 1 TO MaxMenuItems%
LOCATE MenuItem% + 3, Column% ' start position screenMenu
IF Focus% = MenuItem% THEN ' FocusItem?
COLOR 14, 1 ' then: yellow on blue
ELSE '
COLOR 10, 1 ' else: green on blue
END IF
'PRINT USING "##"; MenuItem%;
PRINT " "; MenuItems$(ArrayStartItem% + MenuItem% - 1) ' display Menuitems
NEXT MenuItem%
CALL DrawBox(x1%, y1%, x2%, y2%, Frame%)
'Wait for keypress
DO
k$ = INKEY$
_LIMIT 30 ' max 30 loops per second (don't hog CPU)
IF k$ <> "" THEN ' Avoid ASC error for empty!
IF ASC(k$) = 1 THEN ' normal keypress codes
k% = ASC(k$)
ELSE ' 2 byte codes
k% = ASC(RIGHT$(k$, 1))
END IF
END IF
LOOP UNTIL k$ <> ""
SELECT CASE k%
CASE ESC ' <ESC> key: choice% = 0, exit routine
EXIT DO
CASE ENTER ' <ENTER> Choice% = recordnumber, exit routine
Choice% = Focus% + ArrayStartItem% - 1
CASE UP ' <UP> ARROW
SELECT CASE Focus%
CASE 1
Focus% = MaxMenuItems%
CASE ELSE
Focus% = Focus% - 1
END SELECT
CASE DOWN ' <DOWN> ARROW
SELECT CASE Focus%
CASE MaxMenuItems%
Focus% = 1
CASE ELSE
Focus% = Focus% + 1
END SELECT
CASE HOMEKEY ' <HOME> key
ArrayStartItem% = 1
Focus% = 1
CASE ENDKEY ' <END> key
ArrayStartItem% = ArrayUB% - MaxMenuItems% + 1
Focus% = MaxMenuItems%
END SELECT
LOOP UNTIL Choice% <> 0 ' back if nothing selected
SimpelMenu% = Choice%
END FUNCTION 'SimpleMenu ---------------------------
'===================================================
SUB DrawBox (XPos1%, YPos1%, XPos2%, YPos2%, Frame%)
DIM x%
'The CHR$ codes are the extended character codes
SELECT CASE Frame%
CASE 1 'Single line frame
LOCATE XPos1%, YPos1%
PRINT CHR$(218); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(196));
PRINT CHR$(191); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(179)
LOCATE x%, YPos2% + 1: PRINT CHR$(179)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(192); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(196));
PRINT CHR$(217) 'right under corner
CASE ELSE 'Else always make double line frame
LOCATE XPos1%, YPos1%
PRINT CHR$(201); 'left upper corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(187); 'right upper corner
LOCATE XPos2%, XPos2%
FOR x% = XPos1% + 1 TO XPos2% 'left and right vertikal lines
LOCATE x%, YPos1%: PRINT CHR$(186)
LOCATE x%, YPos2% + 1: PRINT CHR$(186)
NEXT x%
LOCATE XPos2%, YPos1%: PRINT CHR$(200); 'left under corner
PRINT STRING$(YPos2% - YPos1%, CHR$(205));
PRINT CHR$(188) 'right under corner
END SELECT
END SUB 'DrawBox --------------------------------------------------
Little Color listing (for programmers like me with eye-problems), to see / test out, what You obtain in Your program:
Code: (Select All)
OPTION _EXPLICIT
DIM fg% 'fg-color
DIM bg% 'bg-color
DIM Keypress$
'Info:
'CONST black = 0, blue = 1, green = 2, cyan = 3, red = 4, magenta = 5, brown = 6, white = 7, grey = 8
'CONST LBlue = 9, Lgreen = 10, Lcyan = 11, Lred = 12, LMagenta = 13, Yellow = 14
'CONST Brt_White = 15, B_black = 16, B_blue = 17, B_green = 18, B_cyan = 19, B_red = 20
'CONST B_magenta = 21, B_brown = 22, B_white = 23, B_grey = 24
'CONST BL_Blue = 25, BL_green = 26, BL_cyan = 27, BL_red = 28, BL_Magenta = 29
'CONST B_Yellow = 30, B_Brt_White = 31
_FULLSCREEN
SCREEN 0
COLOR , 7
CLS
bg% = 0
DO 'Change backgroundcolor after each KeyPress
COLOR , bg%
CLS
GOSUB PrintColors
PRINT:
LOCATE , 21
PRINT "BackgroundColor:"; bg%
LOCATE , 21
PRINT "Press enter for next background color (ESC to stop)";
DO
Keypress$ = INKEY$
_LIMIT 30
LOOP UNTIL Keypress$ <> ""
IF Keypress$ = CHR$(27) THEN EXIT DO
bg% = bg% + 1
IF bg% = 16 THEN bg% = 1
LOOP
END
'=========================== Print forground colors
PrintColors:
FOR fg% = 0 TO 15
COLOR fg%
LOCATE fg% + 4, 20
PRINT fg%; "is this color"
COLOR fg% + 16
LOCATE fg% + 4, 40:
PRINT fg% + 15; "is this color"
NEXT fg%
fg% = 16
COLOR fg% + 15
LOCATE fg% + 3, 40:
PRINT fg% + 15; "is this color"
RETURN '--------------------
|
