04-29-2022, 03:20 AM
RightClickMenu is an easy way to add a small right click popup menu to you programs. There are several menu styles to choose from - or set your own custom menu colors. Just define your menu items and call the function by right clicking on the screen. There are menu separators and items can be disabled/enabled on the fly. The demo code below show how to call and use the function. If you need any help just ask.
This is an older version, I lost the newer one that had more menu styles.
- Dav
This is an older version, I lost the newer one that had more menu styles.
- Dav
Code: (Select All)
'====================
'RIGHT-CLICK-MENU.BAS
'====================
'Easy to use right click popup menu.
'Coded by Dav JULY/2013
'Here's a single FUNCTION easy to add to your programs to have a right click popup menu.
'Several menu styles to choose from - or set your own custom menu colors (See FUNCTION).
'Menu lets you enable/disble items on the fly and you can also have menu separators.
'Supports many screen sizes, never off screen, and restores original background on exit.
'To use simply add the RightClickMenu% FUNCTION and its defines below to your program.
'Study the demo code below to see how to call and use the function.
'========================================================================================
'================== DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT =======================
'========================================================================================
DECLARE FUNCTION RightClickMenu% (menustyle%) ' (not really needed, but it feels good)
DIM SHARED RightClickItems: RightClickItems = 9 ' <----- Number of items in your menu
DIM SHARED RightClickList$(1 TO RightClickItems) ' (change it to your number)
RightClickList$(1) = "New" ' <------------ List all your menu items here
RightClickList$(2) = "Open..."
RightClickList$(3) = "-Save" ' <------------ Leading minus makes these Disabled Items (-)
RightClickList$(4) = "-Save As..."
RightClickList$(5) = "---" ' <------------ This means it's a separator (---)
RightClickList$(6) = "Settings..."
RightClickList$(7) = "About"
RightClickList$(8) = "---" ' <------------ (another separator)
RightClickList$(9) = "Exit"
' menustyle% values: 1 = Old Windows style
' 2 = New Windows style
' 3 = Dark grey Linux
' 4 = Blue Glass (semi-transparent)
' 5 = Custom colors (user defined)
'========================================================================================
'NOTE: menustyle% #5 is for user defined colors. You can set your own custom colors by
' changing the menu variables inside the RightClickMenu% FUNCTION (look in there).
' Then, call RighClickMenu(5) to use your custom colored menu style.
'========================================================================================
'========================================================================================
'=============================== START DEMO CODE ========================================
'========================================================================================
SCREEN _NEWIMAGE(640, 480, 32)
PAINT (0, 0), _RGB(33, 66, 99)
'=== draw stuff
FOR x = 25 TO 610 STEP 3
FOR y = 25 TO 300 STEP 3
PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
NEXT
NEXT
LOCATE 23, 24: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
PRINT "Right Click Anywhere for Popup menu."
LOCATE 25, 30: PRINT "Select EXIT to quit."
LOCATE 27, 24: PRINT "Press 3 to Enable/Disable: Save"
LOCATE 28, 24: PRINT "Press 4 to Enable/Disable: Save As..."
LOCATE 30, 10: PRINT "(keep making selections to cycle through different menu styles)";
style% = 5 'Start with menu style 5
DO
a% = RightClickMenu%(style%) ' <----- Check for rightclick menu
'=== what did you select?
IF a% > 0 THEN
COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
LOCATE 21, 25: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
style% = style% + 1: IF style% = 6 THEN style% = 1 'cycle mnu styles
END IF
'===============================================================================
'NOTE: You can re-enabled a disabled menu item by removing the leading minus '-'
'from it's name. And you can disable an item by adding a leading minus.
'===============================================================================
'=== Here we disable/enable items 3 & 4 on the fly by pressing 3 or 4.
COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
SELECT CASE INKEY$
CASE IS = "3" ' Toggle Save menu on off
LOCATE 27, 63
IF RightClickList$(3) = "-Save" THEN
RightClickList$(3) = "Save": PRINT "ENABLED ";
ELSE
RightClickList$(3) = "-Save": PRINT "DISABLED";
END IF
CASE IS = "4"
LOCATE 28, 63
IF RightClickList$(4) = "-Save As..." THEN
RightClickList$(4) = "Save As...": PRINT "ENABLED ";
ELSE
RightClickList$(4) = "-Save As...": PRINT "DISABLED";
END IF
END SELECT
LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...
END
'========================================================================================
'================================= END DEMO CODE ========================================
'========================================================================================
'========================================================================================
'==================================== FUNCTION ==========================================
'========================================================================================
FUNCTION RightClickMenu% (menustyle%)
'
'Creates a popup menu at the current mouse x/y position when right button is clicked.
'
'This function returns the value of the menu item seleted. If no selection is made,
'then the function will return a value of 0. REQUIRES RightClickList$() array defined.
'
'menustyle% = Number of menu style to use. There are 5, and #5 is a custom color menu.
' You can set custom menu colors by changing the variables in this FUNCTION.
' (look lower down in this function to find those variables noted).
'
'SAMPLE USE: ClickMe% = RightClickMenu%(3) '<--- Use menu 3. If any selection is made,
' the menu item selected is put into
' the ClickMe% variable.
'
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Cheese = _MOUSEINPUT ' Check for mouse activity.
IF _MOUSEBUTTON(2) THEN ' If user clicked right button, draw menu....
'============================================================================
'Set Custom menu colors for menustyle% #5 here...
'============================================================================
RCMBorder~& = _RGB(255, 255, 255) ' <--- Border around menu
RCMBack~& = _RGB(0, 0, 255) ' <--- Basic menu background color
'menu item colors
RCMEnText~& = _RGB(255, 255, 255) ' <--- Enabled menu item color
RCMDisText~& = _RGB(190, 190, 190) ' <--- Disabled menu item color
'below is the active row colors
RCMHighBack~& = _RGB(255, 255, 255) ' <--- Highlight background color
RCMHighEnText~& = _RGB(0, 0, 255) ' <--- Highlight Enabled Text color
RCMHighDisText~& = _RGB(190, 190, 190) ' <----Highlight Disabled text color
'============================================================================
'=== fail safes values for failing memories
IF menustyle% < 1 THEN menustyle% = 1
IF menustyle% > 5 THEN menustyle% = 5
'Compute Row & Col for LOCATE, and x & y for drawing
Row = FIX(_MOUSEY / 16): Col = FIX(_MOUSEX / 8)
x = Col * 8 - 8: y = Row * 16 - 16
'=== Compute BoxWidth based on longest menu item string length
BoxWidth = 0
FOR t = 1 TO RightClickItems
temp = LEN(RightClickList$(t))
IF LEFT$(RightClickList$(t), 1) = "-" THEN temp = temp - 1
IF temp > BoxWidth THEN BoxWidth = temp
NEXT: BoxWidth = BoxWidth * 8
'=== Compute BoxHeight based on num of menu items
BoxHeight = RightClickItems * 16
'===== Make sure Mouse not too close to edge of screen
'===== If it is, Adjust position here, move in closer...
IF _MOUSEX < 20 THEN
Col = 3: x = Col * 8 - 8:
END IF
IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
xm = _WIDTH - (BoxWidth + 10)
Col = FIX(xm / 8): x = Col * 8 - 8:
END IF
IF _MOUSEY < 20 THEN
Row = 2: y = Row * 16 - 16
END IF
IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
xy = _HEIGHT - (BoxHeight + 10)
Row = FIX(xy / 16): y = Row * 16 - 16
END IF
FirstRow = Row - 1
'=== copy screen using _mem (thanks Steve!)
DIM m AS _MEM, n AS _MEM
m = _MEMIMAGE(0)
n = _MEMNEW(m.SIZE)
_MEMCOPY m, m.OFFSET, m.SIZE TO n, n.OFFSET
'=== trap until buttons up
DO
nibble = _MOUSEINPUT
LOOP UNTIL NOT _MOUSEBUTTON(2)
SELECT CASE menustyle%
CASE 1: 'Classic menu
'=== Draw Box (10 pix padding)
LINE (x - 10, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
LINE (x + 10 + BoxWidth, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
LINE (x - 10, y + 10 + BoxHeight)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
LINE (x + 9 + BoxWidth, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
LINE (x - 9, y + 9 + BoxHeight)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
CASE 2: 'Win7 style
'=== Draw Box (10 pix padding)
LINE (x - 10, y - 10)-(x + 9 + BoxWidth, y + 10 + BoxHeight), _RGB(151, 151, 151), B
LINE (x - 9, y - 9)-(x + 8 + BoxWidth, y + 9 + BoxHeight), _RGB(245, 245, 245), B
LINE (x - 8, y - 8)-(x + 7 + BoxWidth, y + 8 + BoxHeight), _RGB(241, 241, 241), BF
CASE 3: 'Dark Grey Linux style
'=== Draw Box (10 pix padding)
LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(85, 85, 85), BF
LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), _RGB(55, 55, 55), BF
CASE 4: 'Transparent style
'=== Draw Box (10 pix padding)
LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGBA32(0, 0, 0, 150), BF
LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), _RGBA32(100, 200, 255, 100), BF
'=== save original printmode
printmodestatus = _PRINTMODE
_PRINTMODE _KEEPBACKGROUND
CASE 5 'custom colors
LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), RCMBorder~&, BF
LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), RCMBack~&, BF
END SELECT
'draw right drop shadow edge
LINE (x + 11 + BoxWidth, y - 4)-(x + 11 + BoxWidth, y + 11 + BoxHeight), _RGBA32(0, 0, 0, 90), B
LINE (x + 12 + BoxWidth, y - 3)-(x + 12 + BoxWidth, y + 12 + BoxHeight), _RGBA32(0, 0, 0, 60), B
LINE (x + 13 + BoxWidth, y - 2)-(x + 13 + BoxWidth, y + 13 + BoxHeight), _RGBA32(0, 0, 0, 40), B
LINE (x + 14 + BoxWidth, y - 1)-(x + 14 + BoxWidth, y + 14 + BoxHeight), _RGBA32(0, 0, 0, 25), B
LINE (x + 15 + BoxWidth, y)-(x + 15 + BoxWidth, y + 15 + BoxHeight), _RGBA32(0, 0, 0, 10), B
'draw bottom drop shadow edge
LINE (x - 4, y + 11 + BoxHeight)-(x + 10 + BoxWidth, y + 11 + BoxHeight), _RGBA32(0, 0, 0, 90), B
LINE (x - 3, y + 12 + BoxHeight)-(x + 11 + BoxWidth, y + 12 + BoxHeight), _RGBA32(0, 0, 0, 60), B
LINE (x - 2, y + 13 + BoxHeight)-(x + 12 + BoxWidth, y + 13 + BoxHeight), _RGBA32(0, 0, 0, 40), B
LINE (x - 1, y + 14 + BoxHeight)-(x + 13 + BoxWidth, y + 14 + BoxHeight), _RGBA32(0, 0, 0, 25), B
LINE (x, y + 15 + BoxHeight)-(x + 14 + BoxWidth, y + 15 + BoxHeight), _RGBA32(0, 0, 0, 10), B
DO
Cheese = _MOUSEINPUT
'=== if in bounds of menu space
IF _MOUSEX > x AND _MOUSEX < x + BoxWidth AND _MOUSEY > y AND _MOUSEY < y + BoxHeight THEN
'=== Draw items
IF CurRow <> FIX(_MOUSEY / 16) THEN
FOR t = 0 TO RightClickItems - 1
IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
'If highlighted row, draw highlight colors...
SELECT CASE menustyle%
CASE 1: COLOR _RGB(255, 255, 255), _RGB(8, 36, 107) 'classic
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(8, 36, 107)
CASE 2: COLOR _RGB(0, 0, 0), _RGB(215, 225, 235) 'win7
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(215, 225, 235)
CASE 3: COLOR _RGB(50, 50, 50), _RGB(180, 180, 180) 'dark grey linux
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(180, 180, 180)
CASE 4: COLOR _RGB(130, 255, 255) 'transparent
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127)
CASE 5
COLOR RCMHighEnText~&, RCMHighBack~& 'custom
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR RCMHighDisText~&, RCMHighBack~&
END SELECT
ELSE
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
SELECT CASE menustyle%
CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
CASE 2: COLOR _RGB(127, 127, 127), _RGB(240, 240, 240) 'win7
CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
CASE 4: COLOR _RGB(127, 127, 127)
CASE 5: COLOR RCMDisText~&, RCMBack~&
END SELECT
ELSE
SELECT CASE menustyle%
CASE 1: COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
CASE 2: COLOR _RGB(0, 0, 0), _RGB(240, 240, 240)
CASE 3: COLOR _RGB(213, 209, 199), _RGB(55, 55, 55)
CASE 4: COLOR _RGB(200, 200, 200)
CASE 5: COLOR RCMEnText~&, RCMBack~&
END SELECT
END IF
END IF
padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme + 1
IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
LOCATE Row + t, Col - 1
IF RightClickList$(t + 1) = "---" THEN
SELECT CASE menustyle%
CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
CASE 2: COLOR _RGB(208, 208, 208), _RGB(240, 240, 240)
CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55)
CASE 4: COLOR _RGB(0, 0, 0)
CASE 5: COLOR RCMDisText~&, RCMBack~&
END SELECT
PRINT STRING$((BoxWidth / 8) + 2, 196);
ELSE
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
ELSE
PRINT " "; RightClickList$(t + 1); pad$; " ";
END IF
SELECT CASE menustyle%
CASE 2: 'win7 box around highlight area
'=== Draw box around highlighted
IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
BoxRow = FIX(_MOUSEY / 16): by = BoxRow * 16 - 16
LINE (x - 8, by + 16)-(x + BoxWidth + 7, by + 31), _RGB(174, 207, 247), B
END IF
CASE 3: 'dark grey
'=== Draw box around highlighted
IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
BoxRow = FIX(_MOUSEY / 16): by = BoxRow * 16 - 16
LINE (x - 8, by + 16)-(x + BoxWidth + 7, by + 31), _RGB(240, 240, 240), B
END IF
END SELECT
END IF
NEXT
END IF
'=== left click makes a selection
IF _MOUSEBUTTON(1) THEN
sel = FIX(_MOUSEY / 16) - FirstRow + 1
'only select if not a seperator and not disabled
IF RightClickList$(sel) <> "---" THEN
IF LEFT$(RightClickList$(sel), 1) <> "-" THEN
RightClickMenu% = sel: EXIT DO
END IF
END IF
END IF
'=== right click closes menu
IF _MOUSEBUTTON(2) THEN EXIT DO
ELSE
'=== Draw items
IF FIX(_MOUSEY / 16) <> CurRow THEN
FOR t = 0 TO RightClickItems - 1
padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme + 1
IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
LOCATE Row + t, Col - 1
IF RightClickList$(t + 1) = "---" THEN
SELECT CASE menustyle%
CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
CASE 2: COLOR _RGB(208, 208, 208), _RGB(240, 240, 240) 'win7
CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
CASE 4: COLOR _RGB(0, 0, 0)
CASE 5: COLOR RCMDisText~&, RCMBack~&
END SELECT
PRINT STRING$((BoxWidth / 8) + 2, 196);
ELSE
IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
SELECT CASE menustyle%
CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
CASE 2: COLOR _RGB(127, 127, 127), _RGB(240, 240, 240) 'win7
CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
CASE 4: COLOR _RGB(127, 127, 127)
CASE 5: COLOR RCMDisText~&, RCMBack~&
END SELECT
PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
ELSE
SELECT CASE menustyle%
CASE 1: COLOR _RGB(0, 0, 0), _RGB(214, 211, 206) 'classic
CASE 2: COLOR _RGB(0, 0, 0), _RGB(240, 240, 240) 'win7
CASE 3: COLOR _RGB(213, 209, 199), _RGB(55, 55, 55) 'dark grey
CASE 4: COLOR _RGB(200, 200, 200)
CASE 5: COLOR RCMEnText~&, RCMBack~&
END SELECT
PRINT " "; RightClickList$(t + 1); pad$; " ";
END IF
END IF
NEXT
END IF
IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO
END IF
'=== Mark current row mouse is in
CurRow = FIX(_MOUSEY / 16)
LOOP
'=== restore screen
_MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
_MEMFREE m: _MEMFREE n
'=== restore original printmode
IF menustyle% = 4 THEN
SELECT CASE printmodestatus
CASE 1: _PRINTMODE _KEEPBACKGROUND
CASE 2: _PRINTMODE _ONLYBACKGROUND
CASE 3: _PRINTMODE _FILLBACKGROUND
END SELECT
END IF
END IF
END FUNCTION
'================================================================================
'================================================================================