Qbasic menú horizontal o vertical scroll mostrar items que no caben en pantalla

[César Krall]

Este código sirve para mostrar un menú donde se puede hacer scroll para mostrar opciones que no caben en pantalla en QuickBasic:

Código: [Seleccionar]

'HMenu          Ray Thomas      March 2002

'A horizontally scrolling menu

OPTION BASE 1

DIM MenuArray(100) AS STRING * 15       'Contains the menu items
DIM Colmns AS INTEGER                   'Number of columns in the menu
DIM Rows AS INTEGER                     'Number of rows in the menu
DIM TotColmns AS INTEGER                'Total number of columns that can be made
DIM ColmnWid AS INTEGER                 'Column width = Menu item width
DIM Gap AS INTEGER                      'Gap between columns
DIM MenuItems AS INTEGER                'Number of items in the ManuArray
DIM MaxDisplay AS INTEGER               'Max number of menu items that can be displayed
DIM FirstItem AS INTEGER                'First menu item to be diplayed
DIM HiLiteItem AS INTEGER               'Menu item that is highlighted
DIM XMenuPosn AS INTEGER                'X position of the first menu item
DIM YMenuPosn AS INTEGER                'Y position of the first menu item
DIM XItemPosn AS INTEGER                'X position of columns
DIM UserIn AS STRING                    'User input
DIM Count AS INTEGER                    'Loop counter

'*** Although MenuArray has been dimensioned with 100 elements ***
'*** not all of them need be filled ***
'*** A standard length was chosen to make the columns of equal width
'*** 53 was chosen as it is a prime number, which should test the calculations ***

'*** Fill the array ***

'*** The CHR$(Count + 32) is here because I want a unique character in ***
'*** the menu items - it's another aid to navigation around the menu ***

FOR Count = 1 TO 53
        MenuArray$(Count) = CHR$(Count + 32) + " Menu Item " + STR$(Count)
NEXT Count

'*** Inititialise the other variables ***

Rows = 10
Colmns = 3
MenuItems = 53
FirstItem = 1
HiLiteItem = 1
MaxDisplay = Rows * Colmns
XMenuPosn = 5
YMenuPosn = 5
TotColmns = FIX((MenuItems + (Rows - 1)) / Rows)
Gap = 5
ColmnDist = LEN(MenuArray$(1)) + Gap

CLS

DO
        GOSUB DrawMenu          '*** Draw the menu ***
        GOSUB UserInput         '*** Get the user input ***

LOOP UNTIL UserIn$ = CHR$(27) OR UserIn$ = CHR$(13)

LOCATE YMenuPosn + Rows + 3, XMenuPosn

IF UserIn$ = CHR$(27) THEN PRINT "ESC pressed"
IF UserIn$ = CHR$(13) THEN PRINT "Selected menu item = "; MenuArray(HiLiteItem)

END

DrawMenu:

'*** Draw the menu - obviously ***
       
XItemPosn = XMenuPosn
LOCATE YMenuPosn, XItemPosn

FOR Count = FirstItem TO FirstItem + MaxDisplay - 1
        PRINT SPACE$(ColmnDist);
        LOCATE CSRLIN + 1, XMenuPosn
        IF Count MOD Rows = 0 THEN
                XItemPosn = XItemPosn + ColmnDist
                LOCATE YMenuPosn, XItemPosn
        END IF
NEXT Count

XItemPosn = XMenuPosn
LOCATE YMenuPosn, XItemPosn

FOR Count = FirstItem TO FirstItem + MaxDisplay - 1
        PRINT MenuArray$(Count);
        LOCATE CSRLIN + 1, XItemPosn
        IF Count MOD Rows = 0 THEN
                XItemPosn = XItemPosn + ColmnDist
                LOCATE YMenuPosn, XItemPosn
        END IF
NEXT Count

IF HiLiteItem > FirstItem + MaxDisplay - 1 THEN
        DO
                FirstItem = FirstItem + Rows
        LOOP UNTIL HiLiteItem < FirstItem + MaxDisplay
END IF

IF HiLiteItem < FirstItem THEN
        DO
                FirstItem = FirstItem - Rows
        LOOP UNTIL HiLiteItem >= FirstItem
END IF

XItemPosn = XMenuPosn
LOCATE YMenuPosn, XItemPosn

FOR Count = FirstItem TO FirstItem + MaxDisplay - 1
        PRINT MenuArray$(Count);
        LOCATE CSRLIN + 1, XItemPosn
        IF Count MOD Rows = 0 THEN
                XItemPosn = XItemPosn + ColmnDist
                LOCATE YMenuPosn, XItemPosn
        END IF
NEXT Count
XItemPosn = XMenuPosn

XItemPosn = XMenuPosn
IF HiLiteItem > 1 THEN LOCATE YMenuPosn + ((HiLiteItem - FirstItem) MOD Rows), XItemPosn + (FIX((HiLiteItem - FirstItem) / Rows) * ColmnDist)
IF HiLiteItem = 1 THEN LOCATE YMenuPosn, XItemPosn
COLOR 0, 7
PRINT MenuArray$(HiLiteItem);
COLOR 7, 0

'*** Print the << and / or the >> ***

LOCATE YMenuPosn - 2, XMenuPosn
PRINT "  "
LOCATE YMenuPosn - 2, XMenuPosn + ((Colmns * ColmnDist) - Gap - 2)
PRINT "  "

IF FirstItem > Rows THEN
        LOCATE YMenuPosn - 2, XMenuPosn
        PRINT "<<"
END IF

IF FirstItem < MenuItems - MaxDisplay THEN
        LOCATE YMenuPosn - 2, XMenuPosn + ((Colmns * ColmnDist) - Gap - 2)
        PRINT ">>"
END IF


RETURN

UserInput:

'*** Get and process the user input ***

UserIn$ = ""    '*** Reset UserIn$ ***

DO
        UserIn$ = INKEY$
LOOP UNTIL UserIn$ <> ""

SELECT CASE UserIn$

        CASE CHR$(0) + CHR$(80) '*** Down arrow pressed ***

                IF HiLiteItem < MenuItems THEN HiLiteItem = HiLiteItem + 1
       
        CASE CHR$(0) + CHR$(72) '*** Up arrow pressed ***

                IF HiLiteItem - 1 <> 0 THEN HiLiteItem = HiLiteItem - 1

        CASE CHR$(0) + CHR$(75) '*** Left arrow pressed ***
       
                IF HiLiteItem > Rows THEN HiLiteItem = HiLiteItem - Rows

        CASE CHR$(0) + CHR$(77) '*** Right arrow pressed ***

                IF HiLiteItem < (TotColmns - 1) * Rows + 1 THEN HiLiteItem = HiLiteItem + Rows
                IF HiLiteItem > MenuItems THEN HiLiteItem = MenuItems

        CASE CHR$(0) + CHR$(71) '*** Home pressed ***

                HiLiteItem = 1

        CASE CHR$(0) + CHR$(79) '*** End pressed ***

                HiLiteItem = MenuItems

        CASE CHR$(0) + CHR$(73) '*** Page Up pressed ***

                IF HiLiteItem > MaxDisplay THEN
                        HiLiteItem = HiLiteItem - MaxDisplay
                ELSE
                        HiLiteItem = 1
                END IF

        CASE CHR$(0) + CHR$(81) '*** Page Down pressed ***
               
                IF HiLiteItem < MenuItems - MaxDisplay THEN
                        HiLiteItem = HiLiteItem + MaxDisplay
                ELSE
                        HiLiteItem = MenuItems
                END IF

        CASE ELSE

                '*** For any other key press find the first menu item ***
                '*** starting with that key ***

                FOR Count = 1 TO MenuItems
                        IF LEFT$(MenuArray$(Count), 1) = UserIn$ THEN
                                HiLiteItem = Count
                                EXIT FOR
                        END IF
                NEXT Count
END SELECT

RETURN

El aspecto del menú puede cambiarse a scroll vertical haciendo el número de filas mayor y disminuyendo el número de columnas a 1 ó 2. En vez de mostrar << y >> puede hacerse que se muestren flechas verticales usando PRINT CHR$(24);CHR$(24) y PRINT CHR$(25);CHR$(25) para reemplazar << y >> lo que permitiría ver: