Author Topic: Pop Up Menu  (Read 338 times)

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Pop Up Menu
« on: July 02, 2020, 04:31:33 AM »
Once, long ago and far away, Dav reminded me that I'd wrote a popup menu system for QB64.  Unfortunately, time and loss of a few drives of mine (and lost of qb64.net) has resulted in that old work just disappearing and being lost to the ether.  :(

Fortunately, since I wrote it once, it wasn't that hard to go back and rewrite the code once again for us!

Code: QB64: [Select]
  1.  
  2. TYPE menu_type
  3.     Handle AS INTEGER
  4.     Xpos AS INTEGER
  5.     Ypos AS INTEGER
  6.     Visible AS INTEGER
  7.     NumOptions AS INTEGER
  8.     BackGround AS _INTEGER64 'backgroundcolor
  9.     TextColor AS _UNSIGNED LONG 'default color of our text
  10.     BorderSize AS INTEGER
  11.     BorderColor AS _UNSIGNED LONG
  12.  
  13. DIM SHARED Menu(1 TO 100) AS menu_type
  14. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  15.  
  16.  
  17.  
  18.  
  19. SCREEN _NEWIMAGE(640, 480, 32)
  20.  
  21. MainMenu = RegisterMenu
  22. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  23.  
  24.  
  25. AddOption MainMenu, "File"
  26. AddOption MainMenu, "Edit"
  27. AddOption MainMenu, "View"
  28. AddOption MainMenu, "Search"
  29. AddOption MainMenu, "---" 'a divider
  30. AddOption MainMenu, "Run"
  31. AddOption MainMenu, "Options"
  32. AddOption MainMenu, "---" 'a divider
  33. AddOption MainMenu, "Help"
  34.  
  35.  
  36.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
  37.         RMB = -1
  38.     ELSE
  39.         RMB = 0
  40.     END IF
  41.     IF RMB THEN
  42.         result = CheckMenu(MainMenu)
  43.         PRINT result
  44.     END IF
  45.     _LIMIT 30
  46.     _DISPLAY
  47.     RMB = _MOUSEBUTTON(2)
  48.  
  49.  
  50.  
  51.  
  52.  
  53. FUNCTION RegisterMenu
  54.     FOR i = 1 TO 100
  55.         IF Menu(i).Handle = 0 THEN
  56.             ClearMenu i 'make certain all old options are erased and blank
  57.             Menu(i).Handle = i
  58.             RegisterMenu = i 'assign a free handle to create a menu
  59.  
  60.             EXIT FUNCTION
  61.         END IF
  62.     NEXT
  63. END FUNCTION 'Return 0 if there's no open menu handles to work with
  64.  
  65. SUB ClearMenu (Handle AS INTEGER)
  66.     Menu(Handle).Handle = 0
  67.     Menu(Handle).Xpos = 0
  68.     Menu(Handle).Ypos = 0
  69.     Menu(Handle).Visible = 0
  70.     Menu(Handle).NumOptions = 0
  71.     Menu(Handle).BackGround = &HFF000000&&
  72.     Menu(Handle).TextColor = &HFFFFFFFF&&
  73.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  74.  
  75. SUB AddOption (Handle AS INTEGER, Options$)
  76.     FOR j = 1 TO 100
  77.         IF Options(Handle, j) = "" THEN
  78.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  79.             Options(Handle, j) = Options$
  80.             EXIT SUB
  81.         END IF
  82.     NEXT
  83.  
  84. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  85.     Menu(Handle).BackGround = Background
  86.     Menu(Handle).BorderSize = Bordersize
  87.     Menu(Handle).BorderColor = BorderColor
  88.  
  89. FUNCTION CheckMenu (Handle)
  90.     DIM Blend AS LONG, Display AS LONG
  91.     DIM Dest AS LONG, Source AS LONG
  92.  
  93.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  94.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
  95.  
  96.     TempScreen = _COPYIMAGE(0)
  97.     Blend = _BLEND: Display = _AUTODISPLAY
  98.     Dest = _DEST: Source = _SOURCE
  99.  
  100.  
  101.     Menu(Handle).Xpos = _MOUSEX
  102.     Menu(Handle).Ypos = _MOUSEY
  103.     X = Menu(Handle).Xpos
  104.     Y = Menu(Handle).Ypos
  105.  
  106.  
  107.     'calculate printwidth and printheight
  108.     FOR i = 1 TO Menu(Handle).NumOptions
  109.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  110.     NEXT
  111.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  112.     ph = _FONTHEIGHT * (i - 1)
  113.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  114.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  115.  
  116.  
  117.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  118.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  119.     ELSE 'use an image as the backdrop to the menu
  120.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  121.     END IF
  122.     FOR i = 1 TO Menu(Handle).BorderSize
  123.         j = i - 1
  124.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  125.     NEXT
  126.  
  127.     COLOR Menu(Handle).TextColor, 0
  128.     FOR i = 1 TO Menu(Handle).NumOptions
  129.         Caption$ = Options(Handle, i)
  130.         IF Caption$ = "---" THEN
  131.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  132.         ELSE
  133.             _PRINTSTRING (X + _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), Caption$
  134.         END IF
  135.     NEXT
  136.  
  137.     MenuScreen = _COPYIMAGE(0)
  138.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  139.     DO
  140.         _DONTBLEND
  141.         _PUTIMAGE (0, 0), MenuScreen
  142.         _BLEND
  143.         WHILE _MOUSEINPUT: WEND
  144.         MX = _MOUSEX: MY = _MOUSEY
  145.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  146.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  147.             IF Options(Handle, Where) <> "---" THEN
  148.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  149.                     CheckMenu = Where
  150.                     done = -1
  151.                 END IF
  152.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  153.                     CheckMenu = 1000 + Where
  154.                     done = -1
  155.                 END IF
  156.             END IF
  157.         ELSE 'we clicked outside the designated menu area
  158.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  159.                 done = -1
  160.             END IF
  161.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  162.                 done = -1
  163.             END IF
  164.         END IF
  165.         _LIMIT 30
  166.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  167.         _DISPLAY
  168.     LOOP UNTIL done
  169.  
  170.     _FREEIMAGE MenuScreen
  171.     _PUTIMAGE , TempScreen, 0
  172.     _FREEIMAGE TempScreen
  173.     COLOR DC, BG
  174.     _DEST Dest: _SOURCE Source
  175.  
  176.  

Note that this is currently a work-in-progress (is anything I ever work on ever really a finished product??), and is subject to alteration/expansion/development (and new bugs) in future releases.

Using it seems fairly self-explanatory, but I'll walk through the basics anyway...

Code: [Select]
MainMenu = RegisterMenuRegister a menu that you want to create

Code: [Select]
SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver borderSet a few simple options for that menu to make it look pretty and fit into your program design.

Code: [Select]
AddOption MainMenu, "File"
AddOption MainMenu, "Edit"
AddOption MainMenu, "View"
AddOption MainMenu, "Search"
AddOption MainMenu, "---" 'a divider
AddOption MainMenu, "Run"
AddOption MainMenu, "Options"
AddOption MainMenu, "---" 'a divider
AddOption MainMenu, "Help"

Set the menu options that you want to appear on your menu.

Code: [Select]
        result = CheckMenu(MainMenu)     
And then later in the program, call that menu and get a result for it.



And that's the basics of the whole process!  :D

For the demo, you call up the menu with a right-click anywhere on the screen, and then......

...I guess if you need me to tell you how to interact with a menu, there's no need for me to explain anything more!  How the heck did you even manage to connect to the internet and find your way to this forum and this topic??!    :P

More options will come in the future (such as keyboard support, custom text colors, highlighting, shadows, and other such things), but what's here now should be sufficient enough for people to play around with an make use of.  (I probably need to add in the routine to free a menu handle sometime soon as well -- you can't do that yet either...)

Currently you can create and play around with up to 100 pop-up menus, with up to 100 options each (if the screen will display that many -- there's no error checking for if it won't!!), so have fun with it, test it out, and report if anything seems buggy or acts oddly at this point in development of it.  ;)

« Last Edit: July 02, 2020, 02:08:00 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 326
Re: Pop Up Menu
« Reply #1 on: July 02, 2020, 09:11:00 AM »
This is really cool. One thing that I found is, if you right click on a divider and THEN try to either button click out of the menu box, it will remain on screen until you make a valid selection. Whereas, just clicking out of the menu box clears it. One time while doing this I did get the number "1007", as if it was storing them up and appending them or something.

"(is anything I ever work on ever really a finished product??)"  I have that issue myself... ;)

EDIT: On further playing around, sometimes the right click will cancel normally. Not sure what I'm doing differently...
« Last Edit: July 02, 2020, 09:14:03 AM by OldMoses »
Andy

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #2 on: July 02, 2020, 02:04:15 PM »
Right click inside the menu (on a valid entry) should close the menu and return a value of 1000 + your choice.  Since you can have from 1 to 100 menu items, a left click will return a value from 1 to 100 for us, so you know anything the result is > 1000, it's been a right click selection.

Clicking outside the menu -- whether a left or right click -- closes the menu and returns a value of 0 for us. 

So currently it's:

Right click to pop open the menu.
A left or right click on the items inside the menu to generate a value of 1 - 100 (left click), or 1001-1100 (right click).
A left or right click on a spacer/divider does nothing, as the menu waits for you to make your intention a little more clear to it.
A left or right click outside the menu will close it and return a value of 0.

See if the above doesn't cover the behavior you're experiencing.  If not, post me as many details on what's going on for you, and I'll try and sort out what the heck is glitching out.  Basic click/select ability is the core of any menu process, and if it's not working correctly, there's not much point in expanding different colors and stuff to make a flawed process just look nicer...  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #3 on: July 02, 2020, 02:15:39 PM »
A quick update/change to make the result a little more intuitive and easy to interpret (to my way of thinking, at least):

Code: QB64: [Select]
  1. TYPE menu_type
  2.     Handle AS INTEGER
  3.     Xpos AS INTEGER
  4.     Ypos AS INTEGER
  5.     Visible AS INTEGER
  6.     NumOptions AS INTEGER
  7.     BackGround AS _INTEGER64 'backgroundcolor
  8.     TextColor AS _UNSIGNED LONG 'default color of our text
  9.     BorderSize AS INTEGER
  10.     BorderColor AS _UNSIGNED LONG
  11.  
  12. DIM SHARED Menu(1 TO 100) AS menu_type
  13. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  14.  
  15.  
  16.  
  17.  
  18. SCREEN _NEWIMAGE(640, 480, 32)
  19.  
  20. MainMenu = RegisterMenu
  21. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  22.  
  23.  
  24. AddOption MainMenu, "File"
  25. AddOption MainMenu, "Edit"
  26. AddOption MainMenu, "View"
  27. AddOption MainMenu, "Search"
  28. AddOption MainMenu, "---" 'a divider
  29. AddOption MainMenu, "Run"
  30. AddOption MainMenu, "Options"
  31. AddOption MainMenu, "---" 'a divider
  32. AddOption MainMenu, "Help"
  33.  
  34.  
  35.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
  36.         RMB = -1
  37.     ELSE
  38.         RMB = 0
  39.     END IF
  40.     IF RMB THEN
  41.         result$ = CheckMenu(MainMenu)
  42.         PRINT result$
  43.     END IF
  44.     _LIMIT 30
  45.     _DISPLAY
  46.     RMB = _MOUSEBUTTON(2)
  47.  
  48.  
  49.  
  50.  
  51.  
  52. FUNCTION RegisterMenu
  53.     FOR i = 1 TO 100
  54.         IF Menu(i).Handle = 0 THEN
  55.             ClearMenu i 'make certain all old options are erased and blank
  56.             Menu(i).Handle = i
  57.             RegisterMenu = i 'assign a free handle to create a menu
  58.  
  59.             EXIT FUNCTION
  60.         END IF
  61.     NEXT
  62. END FUNCTION 'Return 0 if there's no open menu handles to work with
  63.  
  64. SUB ClearMenu (Handle AS INTEGER)
  65.     Menu(Handle).Handle = 0
  66.     Menu(Handle).Xpos = 0
  67.     Menu(Handle).Ypos = 0
  68.     Menu(Handle).Visible = 0
  69.     Menu(Handle).NumOptions = 0
  70.     Menu(Handle).BackGround = &HFF000000&&
  71.     Menu(Handle).TextColor = &HFFFFFFFF&&
  72.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  73.  
  74. SUB AddOption (Handle AS INTEGER, Options$)
  75.     FOR j = 1 TO 100
  76.         IF Options(Handle, j) = "" THEN
  77.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  78.             Options(Handle, j) = Options$
  79.             EXIT SUB
  80.         END IF
  81.     NEXT
  82.  
  83. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  84.     Menu(Handle).BackGround = Background
  85.     Menu(Handle).BorderSize = Bordersize
  86.     Menu(Handle).BorderColor = BorderColor
  87.  
  88. FUNCTION CheckMenu$ (Handle)
  89.     DIM Blend AS LONG, Display AS LONG
  90.     DIM Dest AS LONG, Source AS LONG
  91.  
  92.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  93.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
  94.  
  95.     TempScreen = _COPYIMAGE(0)
  96.     Blend = _BLEND: Display = _AUTODISPLAY
  97.     Dest = _DEST: Source = _SOURCE
  98.  
  99.  
  100.     Menu(Handle).Xpos = _MOUSEX
  101.     Menu(Handle).Ypos = _MOUSEY
  102.     X = Menu(Handle).Xpos
  103.     Y = Menu(Handle).Ypos
  104.  
  105.  
  106.     'calculate printwidth and printheight
  107.     FOR i = 1 TO Menu(Handle).NumOptions
  108.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  109.     NEXT
  110.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  111.     ph = _FONTHEIGHT * (i - 1)
  112.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  113.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  114.  
  115.  
  116.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  117.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  118.     ELSE 'use an image as the backdrop to the menu
  119.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  120.     END IF
  121.     FOR i = 1 TO Menu(Handle).BorderSize
  122.         j = i - 1
  123.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  124.     NEXT
  125.  
  126.     COLOR Menu(Handle).TextColor, 0
  127.     FOR i = 1 TO Menu(Handle).NumOptions
  128.         Caption$ = Options(Handle, i)
  129.         IF Caption$ = "---" THEN
  130.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  131.         ELSE
  132.             _PRINTSTRING (X + _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), Caption$
  133.         END IF
  134.     NEXT
  135.  
  136.     MenuScreen = _COPYIMAGE(0)
  137.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  138.     DO
  139.         _DONTBLEND
  140.         _PUTIMAGE (0, 0), MenuScreen
  141.         _BLEND
  142.         WHILE _MOUSEINPUT: WEND
  143.         MX = _MOUSEX: MY = _MOUSEY
  144.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  145.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  146.             IF Options(Handle, Where) <> "---" THEN
  147.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  148.                     CheckMenu$ = LCASE$(Options(Handle, Where))
  149.                     done = -1
  150.                 END IF
  151.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  152.                     CheckMenu$ = UCASE$(Options(Handle, Where))
  153.                     done = -1
  154.                 END IF
  155.             END IF
  156.         ELSE 'we clicked outside the designated menu area
  157.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  158.                 done = -1
  159.             END IF
  160.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  161.                 done = -1
  162.             END IF
  163.         END IF
  164.         _LIMIT 30
  165.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  166.         _DISPLAY
  167.     LOOP UNTIL done
  168.  
  169.     _FREEIMAGE MenuScreen
  170.     _PUTIMAGE , TempScreen, 0
  171.     _FREEIMAGE TempScreen
  172.     COLOR DC, BG
  173.     _DEST Dest: _SOURCE Source
  174.  

Selections now return the menu item name for us (after all, the user really doesn't know the internal menu item number easily, and there's no reason to add another layer of abstraction to get them for us).   

If a selection is in all lowercase, then the user LEFT clicked on that menu item.
If a selection is in all UPPERCASE, then the user RIGHT clicked on that menu item.
Invalid clicks (such as outside the menu) should return a blank result ("").

I think this should be a little easier to track and interact with than returning the internal menu values themselves for us.  :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 326
Re: Pop Up Menu
« Reply #4 on: July 02, 2020, 04:42:06 PM »
OK, I see what it's doing now, a feature more than a bug. That's outstanding, and such an easy and elegant way to add additional menu items. I was also intrigued by your circular rosette style menus.

I was working on a menu system a short while back, trying to get it to act similar to the QB64 IDE menu bar. I was figuring on making it a standard template for most of my projects. It was not going particularly well and probably contributed to the coding slump I'm currently wrestling with. Harvest season has left me little time to practice my coding skills.

This is probably a better approach anyway. Especially if you don't want to devote a full time margin to menu displays. Keeps the real estate more versatile.
Andy

Offline bplus

  • Forum Resident
  • Posts: 4589
  • B+ nots
Re: Pop Up Menu
« Reply #5 on: July 02, 2020, 05:29:53 PM »
Yes I am admiring the number of lines of code too.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #6 on: July 02, 2020, 06:01:20 PM »
Yes I am admiring the number of lines of code too.

One "hidden" feature which I haven't mentioned yet either, is that you can choose between solid backgrounds or images for you popups.  Take a look at the little demo here:

Code: QB64: [Select]
  1. TYPE menu_type
  2.     Handle AS INTEGER
  3.     Xpos AS INTEGER
  4.     Ypos AS INTEGER
  5.     Visible AS INTEGER
  6.     NumOptions AS INTEGER
  7.     BackGround AS _INTEGER64 'backgroundcolor
  8.     TextColor AS _UNSIGNED LONG 'default color of our text
  9.     HighlightColor AS _UNSIGNED LONG 'default color of any highlighted text
  10.     BorderSize AS INTEGER
  11.     BorderColor AS _UNSIGNED LONG
  12.     Justify AS INTEGER '-1 = Left, 0 = Center, 1 = Right Justify text
  13.  
  14. DIM SHARED Menu(1 TO 100) AS menu_type
  15. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  16.  
  17. 'Menu metavalues
  18. '#C -- center
  19. '#L -- left
  20. '#R -- right
  21. '#Taarrggbb -- hex value color for option text
  22. '#Naarrggbb -- hex value color for inactive text
  23. '#I -- set option inactive
  24.  
  25.  
  26.  
  27. SCREEN _NEWIMAGE(640, 480, 32)
  28.  
  29. MainMenu = RegisterMenu
  30. SunShine = _LOADIMAGE("sunshine.png", 32)
  31. SetMenuBackground MainMenu, SunShine, 2, Silver 'blue background with 2 pixel wide silver border
  32. SetMenuText MainMenu, Left, Green, Green
  33.  
  34. AddOption MainMenu, "File"
  35. AddOption MainMenu, "Edit"
  36. AddOption MainMenu, "View"
  37. AddOption MainMenu, "Search"
  38. AddOption MainMenu, "---" 'a divider
  39. AddOption MainMenu, "Run"
  40. AddOption MainMenu, "Options"
  41. AddOption MainMenu, "---" 'a divider
  42. AddOption MainMenu, "Help"
  43.  
  44.  
  45.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
  46.         RMB = -1
  47.     ELSE
  48.         RMB = 0
  49.     END IF
  50.     IF RMB THEN
  51.         result$ = CheckMenu(MainMenu)
  52.         PRINT result$
  53.     END IF
  54.     _LIMIT 30
  55.     _DISPLAY
  56.     RMB = _MOUSEBUTTON(2)
  57.  
  58.  
  59.  
  60.  
  61.  
  62. FUNCTION RegisterMenu
  63.     FOR i = 1 TO 100
  64.         IF Menu(i).Handle = 0 THEN
  65.             ClearMenu i 'make certain all old options are erased and blank
  66.             Menu(i).Handle = i
  67.             RegisterMenu = i 'assign a free handle to create a menu
  68.  
  69.             EXIT FUNCTION
  70.         END IF
  71.     NEXT
  72. END FUNCTION 'Return 0 if there's no open menu handles to work with
  73.  
  74. SUB ClearMenu (Handle AS INTEGER)
  75.     Menu(Handle).Handle = 0
  76.     Menu(Handle).Xpos = 0
  77.     Menu(Handle).Ypos = 0
  78.     Menu(Handle).Visible = 0
  79.     Menu(Handle).NumOptions = 0
  80.     Menu(Handle).BackGround = &HFF000000&&
  81.     Menu(Handle).TextColor = &HFFFFFFFF&&
  82.     Menu(Handle).Justify = -1 'Left justify by default
  83.     Menu(Handle).HighlightColor = &HFFFFFF00&&
  84.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  85.  
  86. SUB AddOption (Handle AS INTEGER, Options$)
  87.     FOR j = 1 TO 100
  88.         IF Options(Handle, j) = "" THEN
  89.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  90.             Options(Handle, j) = Options$
  91.             EXIT SUB
  92.         END IF
  93.     NEXT
  94.  
  95. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _UNSIGNED LONG)
  96.     Menu(Handle).Justify = Justify
  97.     Menu(Handle).TextColor = TextColor
  98.     Menu(Handle).HighlightColor = HighlightColor
  99.  
  100.  
  101.  
  102. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  103.     Menu(Handle).BackGround = Background
  104.     Menu(Handle).BorderSize = Bordersize
  105.     Menu(Handle).BorderColor = BorderColor
  106.  
  107. FUNCTION CheckMenu$ (Handle)
  108.     DIM Blend AS LONG, Display AS LONG
  109.     DIM Dest AS LONG, Source AS LONG
  110.  
  111.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  112.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
  113.  
  114.     TempScreen = _COPYIMAGE(0)
  115.     Blend = _BLEND: Display = _AUTODISPLAY
  116.     Dest = _DEST: Source = _SOURCE
  117.  
  118.  
  119.     Menu(Handle).Xpos = _MOUSEX
  120.     Menu(Handle).Ypos = _MOUSEY
  121.     X = Menu(Handle).Xpos
  122.     Y = Menu(Handle).Ypos
  123.  
  124.  
  125.     'calculate printwidth and printheight
  126.     FOR i = 1 TO Menu(Handle).NumOptions
  127.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  128.     NEXT
  129.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  130.     ph = _FONTHEIGHT * (i - 1)
  131.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  132.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  133.  
  134.  
  135.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  136.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  137.     ELSE 'use an image as the backdrop to the menu
  138.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  139.     END IF
  140.     FOR i = 1 TO Menu(Handle).BorderSize
  141.         j = i - 1
  142.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  143.     NEXT
  144.  
  145.     COLOR Menu(Handle).TextColor, 0
  146.     FOR i = 1 TO Menu(Handle).NumOptions
  147.         Caption$ = Options(Handle, i)
  148.         IF Caption$ = "---" THEN
  149.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  150.         ELSE
  151.             _PRINTSTRING (X + _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), Caption$
  152.         END IF
  153.     NEXT
  154.  
  155.     MenuScreen = _COPYIMAGE(0)
  156.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  157.     DO
  158.         _DONTBLEND
  159.         _PUTIMAGE (0, 0), MenuScreen
  160.         _BLEND
  161.         WHILE _MOUSEINPUT: WEND
  162.         MX = _MOUSEX: MY = _MOUSEY
  163.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  164.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  165.             IF Options(Handle, Where) <> "---" THEN
  166.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  167.                     CheckMenu$ = LCASE$(Options(Handle, Where))
  168.                     done = -1
  169.                 END IF
  170.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  171.                     CheckMenu$ = UCASE$(Options(Handle, Where))
  172.                     done = -1
  173.                 END IF
  174.             END IF
  175.         ELSE 'we clicked outside the designated menu area
  176.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  177.                 done = -1
  178.             END IF
  179.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  180.                 done = -1
  181.             END IF
  182.         END IF
  183.         _LIMIT 30
  184.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  185.         _DISPLAY
  186.     LOOP UNTIL done
  187.  
  188.     _FREEIMAGE MenuScreen
  189.     _PUTIMAGE , TempScreen, 0
  190.     _FREEIMAGE TempScreen
  191.     COLOR DC, BG
  192.     _DEST Dest: _SOURCE Source

This is a method which I've used a lot in the past, which I think other folks would enjoy utilizing in their code, once they get used to the idea.  ;)

Basically, it comes down to a process as simple as this one:

Step 1, use an _INTEGER64 for your variable type.
Step 2, use _UNSIGNED LONG values for your colors.
Step 3, remember valid image handles are always less than -1.

When combined, you basically can:

Code: [Select]
    IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
        LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
    ELSE 'use an image as the backdrop to the menu
        _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
    END IF

If the value > -1 then use line to draw a solid color fill for the background.  Otherwise, put the image onto the screen as your background.  Just a few extra lines of code inside a project, but it expands the flexibility of a routine quite a bit. in my opinion.  (Not that this little sunshine makes a very good backdrop for a menu, but think of how it might work as a subtle logo self-promotion with the blackjack card image in your game, bplus.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #7 on: July 02, 2020, 06:17:34 PM »
Caption justification has now been added, which allows us to left justify, center, or right justify our menu captions.

Code: QB64: [Select]
  1. CONST Left = -1, Center = 0, Right = 1
  2.  
  3. TYPE menu_type
  4.     Handle AS INTEGER
  5.     Xpos AS INTEGER
  6.     Ypos AS INTEGER
  7.     Visible AS INTEGER
  8.     NumOptions AS INTEGER
  9.     BackGround AS _INTEGER64 'backgroundcolor
  10.     TextColor AS _UNSIGNED LONG 'default color of our text
  11.     HighlightColor AS _UNSIGNED LONG 'default color of any highlighted text
  12.     BorderSize AS INTEGER
  13.     BorderColor AS _UNSIGNED LONG
  14.     Justify AS INTEGER '-1 = Left, 0 = Center, 1 = Right Justify text
  15.  
  16. DIM SHARED Menu(1 TO 100) AS menu_type
  17. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  18.  
  19. 'Menu metavalues
  20. '#C -- center
  21. '#L -- left
  22. '#R -- right
  23. '#Taarrggbb -- hex value color for option text
  24. '#Naarrggbb -- hex value color for inactive text
  25. '#I -- set option inactive
  26.  
  27.  
  28.  
  29. SCREEN _NEWIMAGE(640, 480, 32)
  30.  
  31. MainMenu = RegisterMenu
  32. SunShine = _LOADIMAGE("sunshine.png", 32)
  33. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  34. SetMenuText MainMenu, Left, White, Red
  35.  
  36. AddOption MainMenu, "File"
  37. AddOption MainMenu, "Edit"
  38. AddOption MainMenu, "View"
  39. AddOption MainMenu, "Search"
  40. AddOption MainMenu, "---" 'a divider
  41. AddOption MainMenu, "Run"
  42. AddOption MainMenu, "Options"
  43. AddOption MainMenu, "---" 'a divider
  44. AddOption MainMenu, "Help"
  45.  
  46.  
  47. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for left/center/right
  48.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
  49.         RMB = -1
  50.     ELSE
  51.         RMB = 0
  52.     END IF
  53.     IF RMB THEN
  54.         result$ = CheckMenu(MainMenu)
  55.         PRINT result$
  56.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
  57.         SetMenuText MainMenu, Justify, White, Red
  58.     END IF
  59.     _LIMIT 30
  60.     _DISPLAY
  61.     RMB = _MOUSEBUTTON(2)
  62.  
  63.  
  64.  
  65.  
  66.  
  67. FUNCTION RegisterMenu
  68.     FOR i = 1 TO 100
  69.         IF Menu(i).Handle = 0 THEN
  70.             ClearMenu i 'make certain all old options are erased and blank
  71.             Menu(i).Handle = i
  72.             RegisterMenu = i 'assign a free handle to create a menu
  73.  
  74.             EXIT FUNCTION
  75.         END IF
  76.     NEXT
  77. END FUNCTION 'Return 0 if there's no open menu handles to work with
  78.  
  79. SUB ClearMenu (Handle AS INTEGER)
  80.     Menu(Handle).Handle = 0
  81.     Menu(Handle).Xpos = 0
  82.     Menu(Handle).Ypos = 0
  83.     Menu(Handle).Visible = 0
  84.     Menu(Handle).NumOptions = 0
  85.     Menu(Handle).BackGround = &HFF000000&&
  86.     Menu(Handle).TextColor = &HFFFFFFFF&&
  87.     Menu(Handle).Justify = -1 'Left justify by default
  88.     Menu(Handle).HighlightColor = &HFFFFFF00&&
  89.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  90.  
  91. SUB AddOption (Handle AS INTEGER, Options$)
  92.     FOR j = 1 TO 100
  93.         IF Options(Handle, j) = "" THEN
  94.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  95.             Options(Handle, j) = Options$
  96.             EXIT SUB
  97.         END IF
  98.     NEXT
  99.  
  100. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _UNSIGNED LONG)
  101.     Menu(Handle).Justify = Justify
  102.     Menu(Handle).TextColor = TextColor
  103.     Menu(Handle).HighlightColor = HighlightColor
  104.  
  105.  
  106.  
  107. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  108.     Menu(Handle).BackGround = Background
  109.     Menu(Handle).BorderSize = Bordersize
  110.     Menu(Handle).BorderColor = BorderColor
  111.  
  112. FUNCTION CheckMenu$ (Handle)
  113.     DIM Blend AS LONG, Display AS LONG
  114.     DIM Dest AS LONG, Source AS LONG
  115.  
  116.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  117.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
  118.  
  119.     TempScreen = _COPYIMAGE(0)
  120.     Blend = _BLEND: Display = _AUTODISPLAY
  121.     Dest = _DEST: Source = _SOURCE
  122.  
  123.  
  124.     Menu(Handle).Xpos = _MOUSEX
  125.     Menu(Handle).Ypos = _MOUSEY
  126.     X = Menu(Handle).Xpos
  127.     Y = Menu(Handle).Ypos
  128.  
  129.  
  130.     'calculate printwidth and printheight
  131.     FOR i = 1 TO Menu(Handle).NumOptions
  132.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  133.     NEXT
  134.     ow = pw 'original width
  135.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  136.     ph = _FONTHEIGHT * (i - 1)
  137.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  138.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  139.  
  140.  
  141.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  142.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  143.     ELSE 'use an image as the backdrop to the menu
  144.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  145.     END IF
  146.     FOR i = 1 TO Menu(Handle).BorderSize
  147.         j = i - 1
  148.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  149.     NEXT
  150.  
  151.     COLOR Menu(Handle).TextColor, 0
  152.     FOR i = 1 TO Menu(Handle).NumOptions
  153.         Caption$ = Options(Handle, i)
  154.         justify = Menu(Handle).Justify 'get the defauly justification setting
  155.         SELECT CASE justify
  156.             CASE -1: offset = 0 'left justify
  157.             CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'center
  158.             CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'right justify
  159.         END SELECT
  160.         IF Caption$ = "---" THEN
  161.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  162.         ELSE
  163.             _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  164.         END IF
  165.     NEXT
  166.  
  167.     MenuScreen = _COPYIMAGE(0)
  168.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  169.     DO
  170.         _DONTBLEND
  171.         _PUTIMAGE (0, 0), MenuScreen
  172.         _BLEND
  173.         WHILE _MOUSEINPUT: WEND
  174.         MX = _MOUSEX: MY = _MOUSEY
  175.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  176.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  177.             IF Options(Handle, Where) <> "---" THEN
  178.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  179.                     CheckMenu$ = LCASE$(Options(Handle, Where))
  180.                     done = -1
  181.                 END IF
  182.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  183.                     CheckMenu$ = UCASE$(Options(Handle, Where))
  184.                     done = -1
  185.                 END IF
  186.             END IF
  187.         ELSE 'we clicked outside the designated menu area
  188.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  189.                 done = -1
  190.             END IF
  191.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  192.                 done = -1
  193.             END IF
  194.         END IF
  195.         _LIMIT 30
  196.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  197.         _DISPLAY
  198.     LOOP UNTIL done
  199.  
  200.     _FREEIMAGE MenuScreen
  201.     _PUTIMAGE , TempScreen, 0
  202.     _FREEIMAGE TempScreen
  203.     COLOR DC, BG
  204.     _DEST Dest: _SOURCE Source
  205.  

Just run the demo and select an item several different times, and you can watch as we flip between caption text justification in the menu  with each run.  (It cycles through left, centered, right, repeat.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Richard

  • Forum Regular
  • Posts: 124
Re: Pop Up Menu
« Reply #8 on: July 03, 2020, 06:54:37 AM »
Although this reply is very late  - below is from the archives classified as pure spam by QB64 - I am discontinuing with archives.

Quote



 
 QB64 Community

   
News:

Instructions for creating Android Apps:
http://www.qb64.net/forum/index.php?topic=13162.0


Home
Help
Search
Login
Register

QB64 Community »
Programs (.BAS), Tutorials and Libraries ($INCLUDE, DECLARE LIBRARY, ...) »
Sample Programs (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Easy to use Right click popup menu

« previous next »
Print
Pages: [1] 2
 Author Topic: Easy to use Right click popup menu  (Read 4158 times)

Dav

Hero Member
*****
 
Posts: 649

Easy to use Right click popup menu

« on: July 08, 2013, 08:19:18 pm »
Here's a quick way to add a simple popup menu to programs.  Right Click to bring up the menu anywhere on the screen.  Easy to change menu items, Enable/Disable items, and add separators. Menu size adjusts to menu items. Works in various screen resolutions. Several menu styles. Set your own menu colors.

The screen save/restore method using _MEM I learned from one of Steve's _MEM examples.

- Dav

Updated 7-11-16:  Added several menu styles, custom menu colors, drop shadow.

Code: [Select]
'====================
'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
'================================================================================
'================================================================================
« Last Edit: July 16, 2013, 10:02:54 am by Dav »
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
OlDosLover

Moderator
Hero Member
*****
Posts: 5321
OlDosLover

Re: Easy to use Right click popup menu

« Reply #1 on: July 09, 2013, 12:41:36 am »
Hi all,
    Love this Dav. Such a smart piece of code! Thanks for sharing!
OlDosLover.
 Logged
Dav

Hero Member
*****
 
Posts: 649

Re: Easy to use Right click popup menu

« Reply #2 on: July 09, 2013, 10:28:55 am »
Thanks OlDosLover.

I updated the code to have optional separator in menu, fixed a crashing bug, and tweaked _RGB colors so they show in SCREEN 12 as well (not all did).  I probably should have the colors user adjustable insead of hard coding them in.

- Dav
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
SMcNeill

Moderator
Hero Member
*****
 
Posts: 6232

Re: Easy to use Right click popup menu

« Reply #3 on: July 09, 2013, 10:50:58 am »
A quick mod to your code Dav:

Code: [Select]
'====================
'RIGHT-CLICK-MENU.BAS
'====================
'User defined Right click Popup Menu.
'Menu created on mouse x/y position.
'Easy to add to your programs.
'Coded by Dav JULY/2013


'=== =============DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT ==========================
DECLARE FUNCTION RightClickMenu% ()

DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
DIM SHARED RightClickList$(1 TO RightClickItems)

RightClickList$(1) = "New" '     <------------ List all your menu items here
RightClickList$(2) = "Open..."
RightClickList$(3) = "Save"
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"

'========================================================================================


'=== Demo follows....

SCREEN _NEWIMAGE(640, 480, 32)
font& = _LOADFONT("cour.ttf", 24, "MONOSPACE")
_FONT font&
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 (_HEIGHT - _FONTHEIGHT * 4) / _FONTHEIGHT, 1: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
PRINT "Right Click Anywhere for Popup menu.";
LOCATE (_HEIGHT - _FONTHEIGHT * 2) / _FONTHEIGHT, 1: PRINT "Select EXIT to quit.";

DO

    a% = RightClickMenu% ' <----- Check for rightclick menu

    '=== what did you select?
    IF a% > 0 THEN
        COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
        LOCATE (_HEIGHT - _FONTHEIGHT * 6) / _FONTHEIGHT, 1: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
    END IF

LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...

END



'================================================================================
'================================================================================
'================================================================================
FUNCTION RightClickMenu% ()

'Returns 0 if nothing selected, else return number of item selected.
'Requires RightClickList$ array defined.

Cheese = _MOUSEINPUT

IF _MOUSEBUTTON(2) THEN

    Row = FIX(_MOUSEY / _FONTHEIGHT): Col = FIX(_MOUSEX / _FONTWIDTH)

    x = Col * _FONTWIDTH - _FONTWIDTH: y = Row * _FONTHEIGHT - _FONTHEIGHT

    '=== Compute BoxWidth based on longest menu item string length
    BoxWidth = 0
    FOR t = 1 TO RightClickItems
        temp = LEN(RightClickList$(t)): IF temp > BoxWidth THEN BoxWidth = temp
    NEXT: BoxWidth = BoxWidth * _FONTWIDTH

    '=== Compute BoxHeight based on num of menu items
    BoxHeight = RightClickItems * _FONTHEIGHT

    '===== Make sure Mouse not too close to edge of screen
    '===== If it is, Adjust x & y position here, move in closer...
    IF _MOUSEX < 20 THEN
        Col = 3: x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
        xm = _WIDTH - (BoxWidth + 10)
        Col = FIX(xm / _FONTWIDTH): x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEY < 20 THEN
        Row = 2: y = Row * _FONTHEIGHT - _FONTHEIGHT
    END IF
    IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
        xy = _HEIGHT - (BoxHeight + 10)
        Row = FIX(xy / _FONTHEIGHT): y = Row * _FONTHEIGHT - _FONTHEIGHT
    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)

    '=== 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

    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
            COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
            FOR t = 0 TO RightClickItems - 1
                IF Row + t - FirstRow = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1 THEN
                    'Draw highlight box...
                    COLOR _RGB(255, 255, 255), _RGB(_FONTWIDTH, 36, 107)
                ELSE
                    COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                END IF
                padme = BoxWidth / _FONTWIDTH - LEN(RightClickList$(t + 1))
                IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
                LOCATE Row + t, Col - 1
                IF RightClickList$(t + 1) = "---" THEN
                    COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                    PRINT STRING$((BoxWidth / _FONTWIDTH) + 2, 196);
                ELSE
                    PRINT " "; RightClickList$(t + 1); pad$; " ";
                END IF
            NEXT

            IF _MOUSEBUTTON(1) THEN
                sel = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1
                'only select if not a seperator
                IF RightClickList$(sel) <> "---" THEN
                    RightClickMenu% = sel: EXIT DO
                END IF
            END IF

            IF _MOUSEBUTTON(2) THEN EXIT DO

        ELSE

            '=== Draw items
            FOR t = 0 TO RightClickItems - 1
                padme = BoxWidth / _FONTWIDTH - LEN(RightClickList$(t + 1))
                IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
                LOCATE Row + t, Col - 1
                IF RightClickList$(t + 1) = "---" THEN
                    COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                    PRINT STRING$((BoxWidth / _FONTWIDTH) + 2, 196);
                ELSE
                    COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                    PRINT " "; RightClickList$(t + 1); pad$; " ";
                END IF
            NEXT

            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO

        END IF
    LOOP

    '=== restore screen
    _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
    _MEMFREE m: _MEMFREE n

END IF

END FUNCTION
'================================================================================
'================================================================================
'================================================================================

I stripped out the hard-coded width and height, and swapped in _fontwidth and _fontheight.   We can now use the pop-up with any size MONOSPACE font that we want, and still work as advertised.   :)

(Since I changed the font size, I had to change the locate statements as we were popping off the bottom of the screen and generating problems.  I don't know if they're in the exact screen locations of the old displays, but I tried to keep them down on the bottom portion of the screen where it's still clear. ;))
 Logged
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.
Dav

Hero Member
*****
 
Posts: 649

Re: Easy to use Right click popup menu

« Reply #4 on: July 09, 2013, 11:24:06 am »
Thanks Steve!  It works for me.  I had to change the font size to 16.  Gotta go to work now, will check out your mod more when I get back.

- Dav
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
OlDosLover

Moderator
Hero Member
*****
Posts: 5321
OlDosLover

Re: Easy to use Right click popup menu

« Reply #5 on: July 09, 2013, 09:34:28 pm »
Hi all,
    Dav your original looks ans works even better with the separator in menu.
OlDosLover.
 Logged
OlDosLover

Moderator
Hero Member
*****
Posts: 5321
OlDosLover

Re: Easy to use Right click popup menu

« Reply #6 on: July 09, 2013, 09:37:08 pm »
Hi all,
    That looks very custom Steve. I noted one visual defect. The menu box has all 4 corners missing a chunk.
OlDosLover.
 Logged
SMcNeill

Moderator
Hero Member
*****
 
Posts: 6232

Re: Easy to use Right click popup menu

« Reply #7 on: July 10, 2013, 08:49:26 am »
Quote from: OlDosLover on July 09, 2013, 09:37:08 pm
Hi all,
    That looks very custom Steve. I noted one visual defect. The menu box has all 4 corners missing a chunk.
OlDosLover.

I noticed this as well.  It seems to be because the line statements which were drawing the box used a hard-coded +/- 10 pixel box buffer.   For whatever reason, change the font and the box didn't grow as well to keep up with it.

Try this instead:
Code: [Select]
'====================
'RIGHT-CLICK-MENU.BAS
'====================
'User defined Right click Popup Menu.
'Menu created on mouse x/y position.
'Easy to add to your programs.
'Coded by Dav JULY/2013


'=== =============DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT ==========================
DECLARE FUNCTION RightClickMenu% ()

DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
DIM SHARED RightClickList$(1 TO RightClickItems)

RightClickList$(1) = "New" '     <------------ List all your menu items here
RightClickList$(2) = "Open..."
RightClickList$(3) = "Save"
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"

'========================================================================================


'=== Demo follows....

SCREEN _NEWIMAGE(640, 480, 32)
font& = _LOADFONT("cour.ttf", 24, "MONOSPACE")
_FONT font&
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 (_HEIGHT - _FONTHEIGHT * 4) / _FONTHEIGHT, 1: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
PRINT "Right Click Anywhere for Popup menu.";
LOCATE (_HEIGHT - _FONTHEIGHT * 2) / _FONTHEIGHT, 1: PRINT "Select EXIT to quit.";

DO

    a% = RightClickMenu% ' <----- Check for rightclick menu

    '=== what did you select?
    IF a% > 0 THEN
        COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
        LOCATE (_HEIGHT - _FONTHEIGHT * 6) / _FONTHEIGHT, 1: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
    END IF

LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...

END



'================================================================================
'================================================================================
'================================================================================
FUNCTION RightClickMenu% ()

'Returns 0 if nothing selected, else return number of item selected.
'Requires RightClickList$ array defined.

Cheese = _MOUSEINPUT

IF _MOUSEBUTTON(2) THEN

    Row = FIX(_MOUSEY / _FONTHEIGHT): Col = FIX(_MOUSEX / _FONTWIDTH)

    x = Col * _FONTWIDTH - _FONTWIDTH: y = Row * _FONTHEIGHT - _FONTHEIGHT

    '=== Compute BoxWidth based on longest menu item string length
    BoxWidth = 0
    FOR t = 1 TO RightClickItems
        temp = LEN(RightClickList$(t)): IF temp > BoxWidth THEN BoxWidth = temp
    NEXT: BoxWidth = BoxWidth * _FONTWIDTH

    '=== Compute BoxHeight based on num of menu items
    BoxHeight = RightClickItems * _FONTHEIGHT

    '===== Make sure Mouse not too close to edge of screen
    '===== If it is, Adjust x & y position here, move in closer...
    IF _MOUSEX < 20 THEN
        Col = 3: x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
        xm = _WIDTH - (BoxWidth + 10)
        Col = FIX(xm / _FONTWIDTH): x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEY < 20 THEN
        Row = 2: y = Row * _FONTHEIGHT - _FONTHEIGHT
    END IF
    IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
        xy = _HEIGHT - (BoxHeight + 10)
        Row = FIX(xy / _FONTHEIGHT): y = Row * _FONTHEIGHT - _FONTHEIGHT
    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)

    '=== Draw Box (10 pix padding)
    LINE (x - _FONTWIDTH, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
    LINE (x + _FONTWIDTH + BoxWidth, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
    LINE (x - _FONTWIDTH, y + 10 + BoxHeight)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
    LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
    LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
    LINE (x + _FONTWIDTH - 1 + BoxWidth, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
    LINE (x - _FONTWIDTH + 1, y + 9 + BoxHeight)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), 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
            COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
            FOR t = 0 TO RightClickItems - 1
                IF Row + t - FirstRow = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1 THEN
                    'Draw highlight box...
                    COLOR _RGB(255, 255, 255), _RGB(_FONTWIDTH, 36, 107)
                ELSE
                    COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                END IF
                padme = BoxWidth / _FONTWIDTH - LEN(RightClickList$(t + 1))
                IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
                LOCATE Row + t, Col - 1
                IF RightClickList$(t + 1) = "---" THEN
                    COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                    PRINT STRING$((BoxWidth / _FONTWIDTH) + 2, 196);
                ELSE
                    PRINT " "; RightClickList$(t + 1); pad$; " ";
                END IF
            NEXT

            IF _MOUSEBUTTON(1) THEN
                sel = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1
                'only select if not a seperator
                IF RightClickList$(sel) <> "---" THEN
                    RightClickMenu% = sel: EXIT DO
                END IF
            END IF

            IF _MOUSEBUTTON(2) THEN EXIT DO

        ELSE
            'We went well off the click area.  Close the menu.
            IF _MOUSEX < x - _FONTWIDTH OR _MOUSEX > x + BoxWidth + _FONTWIDTH THEN EXIT DO
            IF _MOUSEY < y OR _MOUSEY > y + BoxHeight THEN EXIT DO

            '=== Draw items
            FOR t = 0 TO RightClickItems - 1
                IF RightClickList$(t + 1) = "---" THEN
                    COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                    _PRINTSTRING (x, y + t * _FONTHEIGHT), STRING$((BoxWidth / _FONTWIDTH) + 1, 196)
                ELSE
                    COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                    _PRINTSTRING (x, y + t * _FONTHEIGHT), RightClickList$(t + 1)
                END IF
            NEXT

            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO

        END IF
    LOOP

    '=== restore screen
    _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
    _MEMFREE m: _MEMFREE n

END IF

END FUNCTION
'================================================================================
'================================================================================
'================================================================================

I've did a good bit of tweaking to this (I hope Dav doesn't mind), but I was thinking of using something like this for a middle-button pop-up in my IDE, and altering his code just saved me a lot of work on having to create my own from scratch.  :)

This makes our box now with _font width/height adjustments.  We also close the box if the user moves the mouse out of bounds completely.   But we no longer get the missing edges as our font size changes.  ;D
 Logged
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.
OlDosLover

Moderator
Hero Member
*****
Posts: 5321
OlDosLover

Re: Easy to use Right click popup menu

« Reply #8 on: July 10, 2013, 11:14:04 am »
Hi all,
    Yep that looks better and is very functional to boot!
OlDosLover.
 Logged
Dav

Hero Member
*****
 
Posts: 649

Re: Easy to use Right click popup menu

« Reply #9 on: July 10, 2013, 11:58:24 am »
That looks nice, Steve!  I'm happy for you to use this menu thing however you need. Glad if it's useful.   :)

I've made a tweak to your tweak.  Actually, I just fixed a bad coding practice in my original code.  I had the menu constantly drawing at all times.  It wasn't too bad to look at in my version, but with the FONT stuff the highlight movement did some serious dragging on my slow pc.  So I changed the code to only update the menu when the mouse moves into a new row.  Works slick as a whistle for me now.

Here's your version with the tweak, and I'll change my original with the fix as well.

- Dav

Steve's version...
Code: [Select]
'====================
'RIGHT-CLICK-MENU.BAS
'====================
'User defined Right click Popup Menu.
'Menu created on mouse x/y position.
'Easy to add to your programs.
'Coded by Dav JULY/2013


'=== =============DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT ==========================
DECLARE FUNCTION RightClickMenu% ()

DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
DIM SHARED RightClickList$(1 TO RightClickItems)

RightClickList$(1) = "New" '     <------------ List all your menu items here
RightClickList$(2) = "Open..."
RightClickList$(3) = "Save"
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"

'========================================================================================


'=== Demo follows....

SCREEN _NEWIMAGE(640, 480, 32)
font& = _LOADFONT("c:\windows\fonts\cour.ttf", 24, "MONOSPACE")
_FONT font&
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 (_HEIGHT - _FONTHEIGHT * 4) / _FONTHEIGHT, 1: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
PRINT "Right Click Anywhere for Popup menu.";
LOCATE (_HEIGHT - _FONTHEIGHT * 2) / _FONTHEIGHT, 1: PRINT "Select EXIT to quit.";

DO

    a% = RightClickMenu% ' <----- Check for rightclick menu

    '=== what did you select?
    IF a% > 0 THEN
        COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
        LOCATE (_HEIGHT - _FONTHEIGHT * 6) / _FONTHEIGHT, 1: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
    END IF

LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...

END



'================================================================================
'================================================================================
'================================================================================
FUNCTION RightClickMenu% ()

'Returns 0 if nothing selected, else return number of item selected.
'Requires RightClickList$ array defined.

Cheese = _MOUSEINPUT

IF _MOUSEBUTTON(2) THEN

    Row = FIX(_MOUSEY / _FONTHEIGHT): Col = FIX(_MOUSEX / _FONTWIDTH)

    x = Col * _FONTWIDTH - _FONTWIDTH: y = Row * _FONTHEIGHT - _FONTHEIGHT

    '=== Compute BoxWidth based on longest menu item string length
    BoxWidth = 0
    FOR t = 1 TO RightClickItems
        temp = LEN(RightClickList$(t)): IF temp > BoxWidth THEN BoxWidth = temp
    NEXT: BoxWidth = BoxWidth * _FONTWIDTH

    '=== Compute BoxHeight based on num of menu items
    BoxHeight = RightClickItems * _FONTHEIGHT

    '===== Make sure Mouse not too close to edge of screen
    '===== If it is, Adjust x & y position here, move in closer...
    IF _MOUSEX < 20 THEN
        Col = 3: x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
        xm = _WIDTH - (BoxWidth + 10)
        Col = FIX(xm / _FONTWIDTH): x = Col * _FONTWIDTH - _FONTWIDTH:
    END IF
    IF _MOUSEY < 20 THEN
        Row = 2: y = Row * _FONTHEIGHT - _FONTHEIGHT
    END IF
    IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
        xy = _HEIGHT - (BoxHeight + 10)
        Row = FIX(xy / _FONTHEIGHT): y = Row * _FONTHEIGHT - _FONTHEIGHT
    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)

    '=== Draw Box (10 pix padding)
    LINE (x - _FONTWIDTH, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
    LINE (x + _FONTWIDTH + BoxWidth, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
    LINE (x - _FONTWIDTH, y + 10 + BoxHeight)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
    LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
    LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
    LINE (x + _FONTWIDTH - 1 + BoxWidth, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
    LINE (x - _FONTWIDTH + 1, y + 9 + BoxHeight)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), 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
            COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
            IF FIX(_MOUSEY / _FONTHEIGHT) <> CurRow THEN
                FOR t = 0 TO RightClickItems - 1
                    IF Row + t - FirstRow = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1 THEN
                        'Draw highlight box...
                        COLOR _RGB(255, 255, 255), _RGB(_FONTWIDTH, 36, 107)
                    ELSE
                        COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                    END IF
                    padme = BoxWidth / _FONTWIDTH - LEN(RightClickList$(t + 1))
                    IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
                    LOCATE Row + t, Col - 1
                    IF RightClickList$(t + 1) = "---" THEN
                        COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                        PRINT STRING$((BoxWidth / _FONTWIDTH) + 2, 196);
                    ELSE
                        PRINT " "; RightClickList$(t + 1); pad$; " ";
                    END IF
                NEXT
            END IF

            IF _MOUSEBUTTON(1) THEN
                sel = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1
                'only select if not a seperator
                IF RightClickList$(sel) <> "---" THEN
                    RightClickMenu% = sel: EXIT DO
                END IF
            END IF

            IF _MOUSEBUTTON(2) THEN EXIT DO

        ELSE
            'We went well off the click area.  Close the menu.
            IF _MOUSEX < x - _FONTWIDTH OR _MOUSEX > x + BoxWidth + _FONTWIDTH THEN EXIT DO
            IF _MOUSEY < y OR _MOUSEY > y + BoxHeight THEN EXIT DO

            '=== Draw items
            IF FIX(_MOUSEY / _FONTHEIGHT) <> CurRow THEN
                FOR t = 0 TO RightClickItems - 1
                    IF RightClickList$(t + 1) = "---" THEN
                        COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
                        _PRINTSTRING (x, y + t * _FONTHEIGHT), STRING$((BoxWidth / _FONTWIDTH + 1), 196)
                    ELSE
                        COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
                        _PRINTSTRING (x, y + t * _FONTHEIGHT), RightClickList$(t + 1)
                    END IF
                NEXT
            END IF

            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO

        END IF

        '=== Mark the current row the mouse is in

        CurRow = FIX(_MOUSEY / _FONTHEIGHT)

    LOOP

    '=== restore screen
    _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
    _MEMFREE m: _MEMFREE n

END IF

END FUNCTION
'================================================================================
'================================================================================
'================================================================================
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
Dav

Hero Member
*****
 
Posts: 649

Re: Easy to use Right click popup menu

« Reply #10 on: July 11, 2013, 05:19:11 pm »
Updated menu program again.  I added the option of enabling/disabling any menu item.  All you do is add a leading minus to the item name and it's disabled. Remove the minus and it's enabled again.  The demo code now shows how to do that.

I'm working on adding a Win7 menu style too so you can choose either classic or a more modern looking menu. Playing with translucent stuff too.

- Dav
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
OlDosLover

Moderator
Hero Member
*****
Posts: 5321
OlDosLover

Re: Easy to use Right click popup menu

« Reply #11 on: July 12, 2013, 06:27:59 am »
Hi all,
    Nice addition Dav. The idea of "skins" sounds good also.
OlDosLover.
 Logged
LeChuck

Hero Member
*****
 
Posts: 1236
18 * 37

Re: Easy to use Right click popup menu

« Reply #12 on: July 13, 2013, 03:19:50 am »
Kick ass demo Dav! I really like this kind of stuff and it's really easy to set up with the RightClickList$ array.
 Logged
No disaster occurs for any single reason.
Dav

Hero Member
*****
 
Posts: 649

Re: Easy to use Right click popup menu

« Reply #13 on: July 16, 2013, 10:10:15 am »
Updated the menu code again.  Added several menu styles and the option setting your own menu colors in the function.  Also gave the menu a drop shadow effect, and tweaked some things.

I wanted to put the custom color variable in the define section, but the _RGB call isn't useful unless already in the desired SCREEN mode, so you have to change those in the FUNCTION.

In the demo, keep making a selection from the menu to cycle through and see the different menu styles.

- Dav
 Logged
(Visit Dav's Qbasic Site) (Grab my IDE)
LeChuck

Hero Member
*****
 
Posts: 1236
18 * 37

Re: Easy to use Right click popup menu

« Reply #14 on: July 16, 2013, 01:33:30 pm »
As with your IDE, the color schemes are amazing. I really like the blue, bright white and darkish gray styles!
 Logged
No disaster occurs for any single reason.
Print
Pages: [1] 2
« previous next »
QB64 Community »
Programs (.BAS), Tutorials and Libraries ($INCLUDE, DECLARE LIBRARY, ...) »
Sample Programs (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Easy to use Right click popup menu
 


SMF 2.0.3 | SMF © 2011, Simple Machines
XHTML
RSS
WAP2

« Last Edit: July 03, 2020, 06:59:40 AM by Richard »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #9 on: July 03, 2020, 11:51:34 PM »
Added line highlighting for the line which we're hovering over to select, as well as support for custom fonts in our menu, as in the demo below:

Code: QB64: [Select]
  1. CONST Left = -1, Center = 0, Right = 1
  2.  
  3. TYPE menu_type
  4.     Handle AS INTEGER
  5.     Xpos AS INTEGER
  6.     Ypos AS INTEGER
  7.     Visible AS INTEGER
  8.     NumOptions AS INTEGER
  9.     BackGround AS _INTEGER64 'backgroundcolor
  10.     TextColor AS _UNSIGNED LONG 'default color of our text
  11.     HighlightColor AS _INTEGER64 'default color of any highlighted text
  12.     BorderSize AS INTEGER
  13.     BorderColor AS _UNSIGNED LONG
  14.     Justify AS INTEGER '-1 = Left, 0 = Center, 1 = Right Justify text
  15.     Font AS INTEGER
  16.  
  17. DIM SHARED Menu(1 TO 100) AS menu_type
  18. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  19.  
  20. SCREEN _NEWIMAGE(640, 480, 32)
  21.  
  22. MainMenu = RegisterMenu
  23. SunShine = _LOADIMAGE("sunshine.png", 32)
  24. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  25. SetMenuText MainMenu, Left, White, &H77FFFF00&&
  26. SetMenuFont MainMenu, "cour.ttf", 20
  27.  
  28. AddOption MainMenu, "File"
  29. AddOption MainMenu, "Edit"
  30. AddOption MainMenu, "View"
  31. AddOption MainMenu, "Search"
  32. AddOption MainMenu, "---" 'a divider
  33. AddOption MainMenu, "Run"
  34. AddOption MainMenu, "Options"
  35. AddOption MainMenu, "---" 'a divider
  36. AddOption MainMenu, "Help"
  37.  
  38.  
  39. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for left/center/right
  40.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
  41.         RMB = -1
  42.     ELSE
  43.         RMB = 0
  44.     END IF
  45.     IF RMB THEN
  46.         result$ = CheckMenu(MainMenu)
  47.         PRINT result$
  48.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
  49.         SetMenuText MainMenu, Justify, White, &H77FFFF00&&
  50.     END IF
  51.     _LIMIT 30
  52.     _DISPLAY
  53.     RMB = _MOUSEBUTTON(2)
  54.  
  55.  
  56.  
  57.  
  58.  
  59. FUNCTION RegisterMenu
  60.     FOR i = 1 TO 100
  61.         IF Menu(i).Handle = 0 THEN
  62.             ClearMenu i 'make certain all old options are erased and blank
  63.             Menu(i).Handle = i
  64.             RegisterMenu = i 'assign a free handle to create a menu
  65.             EXIT FUNCTION
  66.         END IF
  67.     NEXT
  68. END FUNCTION 'Return 0 if there's no open menu handles to work with
  69.  
  70. SUB ClearMenu (Handle AS INTEGER)
  71.     Menu(Handle).Handle = 0
  72.     Menu(Handle).Xpos = 0
  73.     Menu(Handle).Ypos = 0
  74.     Menu(Handle).Visible = 0
  75.     Menu(Handle).NumOptions = 0
  76.     Menu(Handle).BackGround = &HFF000000&&
  77.     Menu(Handle).TextColor = &HFFFFFFFF&&
  78.     Menu(Handle).Justify = -1 'Left justify by default
  79.     Menu(Handle).HighlightColor = &H99FFFF00&&
  80.     Menu(Handle).Font = 16
  81.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  82.  
  83. SUB AddOption (Handle AS INTEGER, Options$)
  84.     FOR j = 1 TO 100
  85.         IF Options(Handle, j) = "" THEN
  86.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  87.             Options(Handle, j) = Options$
  88.             EXIT SUB
  89.         END IF
  90.     NEXT
  91.  
  92. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _INTEGER64)
  93.     Menu(Handle).Justify = Justify
  94.     Menu(Handle).TextColor = TextColor
  95.     Menu(Handle).HighlightColor = HighlightColor
  96.  
  97. SUB SetMenuFont (Handle AS INTEGER, Fontname AS STRING, fontsize AS INTEGER)
  98.     f = _LOADFONT(Fontname, fontsize, "monospace")
  99.     IF f > 0 THEN Menu(Handle).Font = f ELSE Menu(Handle).Font = 16
  100.  
  101.  
  102. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  103.     Menu(Handle).BackGround = Background
  104.     Menu(Handle).BorderSize = Bordersize
  105.     Menu(Handle).BorderColor = BorderColor
  106.  
  107. FUNCTION CheckMenu$ (Handle)
  108.     DIM Blend AS LONG, Display AS LONG
  109.     DIM Dest AS LONG, Source AS LONG
  110.     Font = _FONT
  111.  
  112.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  113.     _FONT Menu(Handle).Font
  114.  
  115.     TempScreen = _COPYIMAGE(0)
  116.     Blend = _BLEND: Display = _AUTODISPLAY
  117.     Dest = _DEST: Source = _SOURCE
  118.  
  119.  
  120.     Menu(Handle).Xpos = _MOUSEX
  121.     Menu(Handle).Ypos = _MOUSEY
  122.     X = Menu(Handle).Xpos
  123.     Y = Menu(Handle).Ypos
  124.  
  125.  
  126.     'calculate printwidth and printheight
  127.     FOR i = 1 TO Menu(Handle).NumOptions
  128.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  129.     NEXT
  130.     ow = pw 'original width
  131.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  132.     ph = _FONTHEIGHT * (i - 1)
  133.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  134.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  135.  
  136.  
  137.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  138.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  139.     ELSE 'use an image as the backdrop to the menu
  140.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  141.     END IF
  142.  
  143.     FOR i = 1 TO Menu(Handle).BorderSize
  144.         j = i - 1
  145.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  146.     NEXT
  147.  
  148.     COLOR Menu(Handle).TextColor, 0
  149.     FOR i = 1 TO Menu(Handle).NumOptions
  150.         Caption$ = Options(Handle, i)
  151.         justify = Menu(Handle).Justify 'get the defauly justification setting
  152.         SELECT CASE justify
  153.             CASE -1: offset = 0 'left justify
  154.             CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'center
  155.             CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'right justify
  156.         END SELECT
  157.  
  158.         IF Caption$ = "---" THEN
  159.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  160.         ELSE
  161.             _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  162.         END IF
  163.     NEXT
  164.  
  165.     MenuScreen = _COPYIMAGE(0)
  166.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  167.     DO
  168.         _DONTBLEND
  169.         _PUTIMAGE (0, 0), MenuScreen
  170.         _BLEND
  171.         WHILE _MOUSEINPUT: WEND
  172.         MX = _MOUSEX: MY = _MOUSEY
  173.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  174.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  175.             i = Where
  176.             _TITLE STR$(i) + "//" + HEX$(Menu(Handle).HighlightColor) + "//" + STR$(Handle)
  177.             IF Options(Handle, i) <> "---" THEN
  178.                 COLOR Menu(Handle).TextColor, 0
  179.                 IF Menu(Handle).HighlightColor > -1 THEN 'use a solid color as the highlight to the current menu choice
  180.                     LINE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor, BF
  181.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Options(Handle, i)
  182.                 ELSE 'use an image as the backdrop to the menu highlight
  183.                     _PUTIMAGE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor
  184.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + i * _FONTHEIGHT), Options(Handle, i)
  185.                 END IF
  186.  
  187.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  188.                     CheckMenu$ = LCASE$(Options(Handle, Where))
  189.                     done = -1
  190.                 END IF
  191.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  192.                     CheckMenu$ = UCASE$(Options(Handle, Where))
  193.                     done = -1
  194.                 END IF
  195.             END IF
  196.         ELSE 'we clicked outside the designated menu area
  197.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
  198.                 done = -1
  199.             END IF
  200.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
  201.                 done = -1
  202.             END IF
  203.         END IF
  204.         _LIMIT 30
  205.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  206.         _DISPLAY
  207.     LOOP UNTIL done
  208.  
  209.     _FREEIMAGE MenuScreen
  210.     _PUTIMAGE , TempScreen, 0
  211.     _FREEIMAGE TempScreen
  212.     COLOR DC, BG
  213.     _DEST Dest: _SOURCE Source
  214.     _FONT Font
  215.  

Note: Just like how you can use an image as the backdrop for your menu (like the sunshine demo above), this also supports use of an image as your highlight to each line.  (So you could draw yourself a nice fancy little frame of roses, or hearts, or whatever suits the theme of your project, and have it overlay the current menu choice, instead of just some colored box.)
« Last Edit: July 03, 2020, 11:52:48 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 326
Re: Pop Up Menu
« Reply #10 on: July 04, 2020, 10:25:47 AM »
When center or right justify is active, I get a funny looking double print on the 'run', 'search' and 'options' menu choices. Left displays fine.
Andy

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #11 on: July 04, 2020, 01:33:36 PM »
When center or right justify is active, I get a funny looking double print on the 'run', 'search' and 'options' menu choices. Left displays fine.

Thanks for the report.  I'll dig into it.  ;)

Edit: Glitch found and fixed.

Code: QB64: [Select]
  1. CONST LeftJustify = -1, CenterJustify = 0, RightJustify = 1
  2.  
  3. TYPE menu_type
  4.     Handle AS INTEGER
  5.     Xpos AS INTEGER
  6.     Ypos AS INTEGER
  7.     Visible AS INTEGER
  8.     NumOptions AS INTEGER
  9.     BackGround AS _INTEGER64 'backgroundcolor
  10.     TextColor AS _UNSIGNED LONG 'default color of our text
  11.     HighlightColor AS _INTEGER64 'default color of any highlighted text
  12.     BorderSize AS INTEGER
  13.     BorderColor AS _UNSIGNED LONG
  14.     Justify AS INTEGER '-1 = LeftJustify, 0 = CenterJustify, 1 = RightJustify Justify text
  15.     Font AS INTEGER
  16.  
  17. DIM SHARED Menu(1 TO 100) AS menu_type
  18. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  19.  
  20. SCREEN _NEWIMAGE(640, 480, 32)
  21.  
  22. MainMenu = RegisterMenu
  23. SunShine = _LOADIMAGE("sunshine.png", 32)
  24. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  25. SetMenuText MainMenu, LeftJustify, White, &H77FFFF00&&
  26. SetMenuFont MainMenu, "cour.ttf", 20
  27.  
  28. AddOption MainMenu, "File"
  29. AddOption MainMenu, "Edit"
  30. AddOption MainMenu, "View"
  31. AddOption MainMenu, "Search"
  32. AddOption MainMenu, "---" 'a divider
  33. AddOption MainMenu, "Run"
  34. AddOption MainMenu, "Options"
  35. AddOption MainMenu, "---" 'a divider
  36. AddOption MainMenu, "Help"
  37.  
  38.  
  39. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for LeftJustify/CenterJustify/RightJustify
  40.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'RightJustify mouse was up, then down (clicked)
  41.         RMB = -1
  42.     ELSE
  43.         RMB = 0
  44.     END IF
  45.     IF RMB THEN
  46.         result$ = CheckMenu(MainMenu)
  47.         PRINT result$
  48.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
  49.         SetMenuText MainMenu, Justify, White, &H77FFFF00&&
  50.     END IF
  51.     _LIMIT 30
  52.     _DISPLAY
  53.     RMB = _MOUSEBUTTON(2)
  54.  
  55.  
  56.  
  57.  
  58.  
  59. FUNCTION RegisterMenu
  60.     FOR i = 1 TO 100
  61.         IF Menu(i).Handle = 0 THEN
  62.             ClearMenu i 'make certain all old options are erased and blank
  63.             Menu(i).Handle = i
  64.             RegisterMenu = i 'assign a free handle to create a menu
  65.             EXIT FUNCTION
  66.         END IF
  67.     NEXT
  68. END FUNCTION 'Return 0 if there's no open menu handles to work with
  69.  
  70. SUB ClearMenu (Handle AS INTEGER)
  71.     Menu(Handle).Handle = 0
  72.     Menu(Handle).Xpos = 0
  73.     Menu(Handle).Ypos = 0
  74.     Menu(Handle).Visible = 0
  75.     Menu(Handle).NumOptions = 0
  76.     Menu(Handle).BackGround = &HFF000000&&
  77.     Menu(Handle).TextColor = &HFFFFFFFF&&
  78.     Menu(Handle).Justify = -1 'LeftJustify justify by default
  79.     Menu(Handle).HighlightColor = &H99FFFF00&&
  80.     Menu(Handle).Font = 16
  81.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  82.  
  83. SUB AddOption (Handle AS INTEGER, Options$)
  84.     FOR j = 1 TO 100
  85.         IF Options(Handle, j) = "" THEN
  86.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  87.             Options(Handle, j) = Options$
  88.             EXIT SUB
  89.         END IF
  90.     NEXT
  91.  
  92. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _INTEGER64)
  93.     Menu(Handle).Justify = Justify
  94.     Menu(Handle).TextColor = TextColor
  95.     Menu(Handle).HighlightColor = HighlightColor
  96.  
  97. SUB SetMenuFont (Handle AS INTEGER, Fontname AS STRING, fontsize AS INTEGER)
  98.     f = _LOADFONT(Fontname, fontsize, "monospace")
  99.     IF f > 0 THEN Menu(Handle).Font = f ELSE Menu(Handle).Font = 16
  100.  
  101.  
  102. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  103.     Menu(Handle).BackGround = Background
  104.     Menu(Handle).BorderSize = Bordersize
  105.     Menu(Handle).BorderColor = BorderColor
  106.  
  107. FUNCTION CheckMenu$ (Handle)
  108.     DIM Blend AS LONG, Display AS LONG
  109.     DIM Dest AS LONG, Source AS LONG
  110.     DIM Down AS INTEGER, Right AS INTEGER
  111.     Font = _FONT: Down = CSRLIN: Right = POS(0)
  112.  
  113.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  114.     TempScreen = _COPYIMAGE(0)
  115.     Blend = _BLEND: Display = _AUTODISPLAY
  116.     Dest = _DEST: Source = _SOURCE
  117.     _FONT Menu(Handle).Font
  118.  
  119.     Menu(Handle).Xpos = _MOUSEX
  120.     Menu(Handle).Ypos = _MOUSEY
  121.     X = Menu(Handle).Xpos
  122.     Y = Menu(Handle).Ypos
  123.  
  124.  
  125.     'calculate printwidth and printheight
  126.     FOR i = 1 TO Menu(Handle).NumOptions
  127.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  128.     NEXT
  129.     ow = pw 'original width
  130.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  131.     ph = _FONTHEIGHT * (i - 1)
  132.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  133.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  134.  
  135.  
  136.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  137.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  138.     ELSE 'use an image as the backdrop to the menu
  139.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  140.     END IF
  141.  
  142.     FOR i = 1 TO Menu(Handle).BorderSize
  143.         j = i - 1
  144.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  145.     NEXT
  146.  
  147.     COLOR Menu(Handle).TextColor, 0
  148.     FOR i = 1 TO Menu(Handle).NumOptions
  149.         Caption$ = Options(Handle, i)
  150.         justify = Menu(Handle).Justify 'get the defauly justification setting
  151.         SELECT CASE justify
  152.             CASE -1: offset = 0 'LeftJustify justify
  153.             CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'CenterJustify
  154.             CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'RightJustify justify
  155.         END SELECT
  156.  
  157.         IF Caption$ = "---" THEN
  158.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  159.         ELSE
  160.             _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  161.         END IF
  162.     NEXT
  163.  
  164.     MenuScreen = _COPYIMAGE(0)
  165.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  166.     DO
  167.         _DONTBLEND
  168.         _PUTIMAGE (0, 0), MenuScreen
  169.         _BLEND
  170.         WHILE _MOUSEINPUT: WEND
  171.         MX = _MOUSEX: MY = _MOUSEY
  172.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  173.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  174.             i = Where
  175.             _TITLE STR$(i) + "//" + HEX$(Menu(Handle).HighlightColor) + "//" + STR$(Handle)
  176.             IF Options(Handle, i) <> "---" THEN
  177.                 COLOR Menu(Handle).TextColor, 0
  178.                 Caption$ = Options(Handle, i)
  179.                 SELECT CASE justify
  180.                     CASE -1: offset = 0 'LeftJustify justify
  181.                     CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'CenterJustify
  182.                     CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'RightJustify justify
  183.                 END SELECT
  184.  
  185.                 IF Menu(Handle).HighlightColor > -1 THEN 'use a solid color as the highlight to the current menu choice
  186.                     LINE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor, BF
  187.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  188.                 ELSE 'use an image as the backdrop to the menu highlight
  189.                     _PUTIMAGE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor
  190.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + i * _FONTHEIGHT), Caption$
  191.                 END IF
  192.  
  193.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
  194.                     CheckMenu$ = LCASE$(Options(Handle, Where))
  195.                     done = -1
  196.                 END IF
  197.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
  198.                     CheckMenu$ = UCASE$(Options(Handle, Where))
  199.                     done = -1
  200.                 END IF
  201.             END IF
  202.         ELSE 'we clicked outside the designated menu area
  203.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
  204.                 done = -1
  205.             END IF
  206.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
  207.                 done = -1
  208.             END IF
  209.         END IF
  210.         _LIMIT 30
  211.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  212.         _DISPLAY
  213.     LOOP UNTIL done
  214.  
  215.     _FREEIMAGE MenuScreen
  216.     _PUTIMAGE , TempScreen, 0
  217.     _FREEIMAGE TempScreen
  218.     COLOR DC, BG
  219.     _DEST Dest: _SOURCE Source
  220.     _FONT Font: LOCATE Down, Right
« Last Edit: July 04, 2020, 02:13:44 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #12 on: July 04, 2020, 03:16:06 PM »
Started on the process of making my own little MMCL (Mini-Menu Command Language).  Just as DRAW is it's own little language inside QB64, I've now started to add my own little formatting language to our menus.

The concept is rather simple -- If your caption starts off with a # symbol, then you've added a processing/formatting command to that caption.

For example:

AddOption MainMenu, "#LEdit"   

AddOption is the routine which we use to add our options to a menu.  MainMenu is the name of the menu which I want to add an option to.  "#LEdit" is the option I'm adding...

Now, in the above, our option starts with a "#", so it has some unique formatting which we have to do with it -- in this case, it's a "#L" command, which simply means "Left Justify".  Our menu might be right justified by default, but by adding the "#L" to the front of our option, we can be certain that this singular caption is always left justified.  (For emphasis purposes, perhaps??  I dunno WHY we'd want one option to be formatted differently from the others, but I like the idea of knowing I could do it, if I wanted to.  :P )

Here's a demo of the start of the command options, as I get to work on them:

Code: QB64: [Select]
  1. CONST LeftJustify = -1, CenterJustify = 0, RightJustify = 1
  2.  
  3. TYPE menu_type
  4.     Handle AS INTEGER
  5.     Xpos AS INTEGER
  6.     Ypos AS INTEGER
  7.     Visible AS INTEGER
  8.     NumOptions AS INTEGER
  9.     BackGround AS _INTEGER64 'backgroundcolor
  10.     TextColor AS _UNSIGNED LONG 'default color of our text
  11.     HighlightColor AS _INTEGER64 'default color of any highlighted text
  12.     BorderSize AS INTEGER
  13.     BorderColor AS _UNSIGNED LONG
  14.     Justify AS INTEGER '-1 = LeftJustify, 0 = CenterJustify, 1 = RightJustify Justify text
  15.     Font AS INTEGER
  16.  
  17. DIM SHARED Menu(1 TO 100) AS menu_type
  18. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  19.  
  20. SCREEN _NEWIMAGE(640, 480, 32)
  21.  
  22. MainMenu = RegisterMenu
  23. SunShine = _LOADIMAGE("sunshine.png", 32)
  24. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  25. SetMenuText MainMenu, LeftJustify, White, &H77FFFF00&&
  26. SetMenuFont MainMenu, "cour.ttf", 20
  27.  
  28. AddOption MainMenu, "File"
  29. AddOption MainMenu, "#LEdit"
  30. AddOption MainMenu, "#CView"
  31. AddOption MainMenu, "#RSearch"
  32. AddOption MainMenu, "---" 'a divider
  33. AddOption MainMenu, "#L#TFF00FF00Run"
  34. AddOption MainMenu, "Options"
  35. AddOption MainMenu, "---" 'a divider
  36. AddOption MainMenu, "Help"
  37.  
  38.  
  39. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for LeftJustify/CenterJustify/RightJustify
  40.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'RightJustify mouse was up, then down (clicked)
  41.         RMB = -1
  42.     ELSE
  43.         RMB = 0
  44.     END IF
  45.     IF RMB THEN
  46.         result$ = CheckMenu(MainMenu)
  47.         PRINT result$
  48.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
  49.         SetMenuText MainMenu, Justify, White, &H77FFFF00&&
  50.     END IF
  51.     _LIMIT 30
  52.     _DISPLAY
  53.     RMB = _MOUSEBUTTON(2)
  54.  
  55.  
  56.  
  57.  
  58.  
  59. FUNCTION RegisterMenu
  60.     FOR i = 1 TO 100
  61.         IF Menu(i).Handle = 0 THEN
  62.             ClearMenu i 'make certain all old options are erased and blank
  63.             Menu(i).Handle = i
  64.             RegisterMenu = i 'assign a free handle to create a menu
  65.             EXIT FUNCTION
  66.         END IF
  67.     NEXT
  68. END FUNCTION 'Return 0 if there's no open menu handles to work with
  69.  
  70. SUB ClearMenu (Handle AS INTEGER)
  71.     Menu(Handle).Handle = 0
  72.     Menu(Handle).Xpos = 0
  73.     Menu(Handle).Ypos = 0
  74.     Menu(Handle).Visible = 0
  75.     Menu(Handle).NumOptions = 0
  76.     Menu(Handle).BackGround = &HFF000000&&
  77.     Menu(Handle).TextColor = &HFFFFFFFF&&
  78.     Menu(Handle).Justify = -1 'LeftJustify justify by default
  79.     Menu(Handle).HighlightColor = &H99FFFF00&&
  80.     Menu(Handle).Font = 16
  81.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  82.  
  83. SUB AddOption (Handle AS INTEGER, Options$)
  84.     FOR j = 1 TO 100
  85.         IF Options(Handle, j) = "" THEN
  86.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  87.             Options(Handle, j) = Options$
  88.             EXIT SUB
  89.         END IF
  90.     NEXT
  91.  
  92. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _INTEGER64)
  93.     Menu(Handle).Justify = Justify
  94.     Menu(Handle).TextColor = TextColor
  95.     Menu(Handle).HighlightColor = HighlightColor
  96.  
  97. SUB SetMenuFont (Handle AS INTEGER, Fontname AS STRING, fontsize AS INTEGER)
  98.     f = _LOADFONT(Fontname, fontsize, "monospace")
  99.     IF f > 0 THEN Menu(Handle).Font = f ELSE Menu(Handle).Font = 16
  100.  
  101.  
  102. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
  103.     Menu(Handle).BackGround = Background
  104.     Menu(Handle).BorderSize = Bordersize
  105.     Menu(Handle).BorderColor = BorderColor
  106.  
  107. FUNCTION CheckMenu$ (Handle)
  108.     DIM Blend AS LONG, Display AS LONG
  109.     DIM Dest AS LONG, Source AS LONG
  110.     DIM Down AS INTEGER, Right AS INTEGER
  111.     Font = _FONT: Down = CSRLIN: Right = POS(0)
  112.  
  113.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
  114.     TempScreen = _COPYIMAGE(0)
  115.     Blend = _BLEND: Display = _AUTODISPLAY
  116.     Dest = _DEST: Source = _SOURCE
  117.     _FONT Menu(Handle).Font
  118.  
  119.     Menu(Handle).Xpos = _MOUSEX
  120.     Menu(Handle).Ypos = _MOUSEY
  121.     X = Menu(Handle).Xpos
  122.     Y = Menu(Handle).Ypos
  123.  
  124.  
  125.     'calculate printwidth and printheight
  126.     FOR i = 1 TO Menu(Handle).NumOptions
  127.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
  128.     NEXT
  129.     ow = pw 'original width
  130.     pw = pw + 2 * _FONTWIDTH 'a border around either side
  131.     ph = _FONTHEIGHT * (i - 1)
  132.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
  133.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
  134.  
  135.  
  136.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
  137.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
  138.     ELSE 'use an image as the backdrop to the menu
  139.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
  140.     END IF
  141.  
  142.     FOR i = 1 TO Menu(Handle).BorderSize
  143.         j = i - 1
  144.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
  145.     NEXT
  146.  
  147.     COLOR Menu(Handle).TextColor, 0
  148.     FOR i = 1 TO Menu(Handle).NumOptions
  149.         GOSUB getsettings
  150.         IF Caption$ = "---" THEN
  151.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
  152.         ELSE
  153.             _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  154.         END IF
  155.     NEXT
  156.  
  157.     MenuScreen = _COPYIMAGE(0)
  158.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  159.     DO
  160.         _DONTBLEND
  161.         _PUTIMAGE (0, 0), MenuScreen
  162.         _BLEND
  163.         WHILE _MOUSEINPUT: WEND
  164.         MX = _MOUSEX: MY = _MOUSEY
  165.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
  166.             i = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
  167.             GOSUB getsettings
  168.  
  169.             IF Caption$ <> "---" THEN
  170.                 IF Menu(Handle).HighlightColor > -1 THEN 'use a solid color as the highlight to the current menu choice
  171.                     LINE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor, BF
  172.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
  173.                 ELSE 'use an image as the backdrop to the menu highlight
  174.                     _PUTIMAGE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), Menu(Handle).HighlightColor
  175.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + i * _FONTHEIGHT), Caption$
  176.                 END IF
  177.  
  178.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
  179.                     CheckMenu$ = LCASE$(Options(Handle, i))
  180.                     done = -1
  181.                 END IF
  182.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
  183.                     CheckMenu$ = UCASE$(Options(Handle, i))
  184.                     done = -1
  185.                 END IF
  186.             END IF
  187.         ELSE 'we clicked outside the designated menu area
  188.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
  189.                 done = -1
  190.             END IF
  191.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
  192.                 done = -1
  193.             END IF
  194.         END IF
  195.         _LIMIT 30
  196.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
  197.         _DISPLAY
  198.     LOOP UNTIL done
  199.  
  200.     DO 'strip off any of the command formatting from our return value
  201.         temp$ = GetCommand$(CheckMenu$)
  202.     LOOP UNTIL temp$ = ""
  203.  
  204.  
  205.     _FREEIMAGE MenuScreen
  206.     _PUTIMAGE , TempScreen, 0
  207.     _FREEIMAGE TempScreen
  208.     COLOR DC, BG
  209.     _DEST Dest: _SOURCE Source
  210.     _FONT Font: LOCATE Down, Right
  211.  
  212.  
  213.     getsettings: 'Get the default settings, and then modify them (if needed) according to our command line options
  214.  
  215.     justify = Menu(Handle).Justify 'get the default justification setting
  216.     textcolor&& = Menu(Handle).TextColor 'the default color for our text
  217.  
  218.     'And then parse any custom line-by-line settings from command lines
  219.  
  220.     Caption$ = Options(Handle, i)
  221.     DO
  222.         COM$ = GetCommand$(Caption$)
  223.         SELECT CASE LEFT$(COM$, 2)
  224.             CASE "#L": justify = -1
  225.             CASE "#C": justify = 0
  226.             CASE "#R": justify = 1
  227.             CASE "#T": textcolor&& = VAL("&H" + MID$(COM$, 3) + "&&")
  228.         END SELECT
  229.     LOOP UNTIL COM$ = ""
  230.  
  231.     SELECT CASE justify
  232.         CASE -1: offset = 0 'LeftJustify justify
  233.         CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'CenterJustify
  234.         CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'RightJustify justify
  235.     END SELECT
  236.     COLOR textcolor&&, 0
  237.  
  238.     RETURN
  239.  
  240. FUNCTION GetCommand$ (Caption$)
  241.     SELECT CASE UCASE$(LEFT$(Caption$, 2))
  242.         CASE "#L", "#R", "#C"
  243.             GetCommand$ = LEFT$(Caption$, 2)
  244.             Caption$ = MID$(Caption$, 3)
  245.         CASE "#H", "#T"
  246.             GetCommand$ = LEFT$(Caption$, 10)
  247.             Caption$ = MID$(Caption$, 11)
  248.         CASE ELSE
  249.             'return a null string and don't change caption$
  250.     END SELECT

As you can see, we now have the ability to set custom justification and custom text colors for each option in our menu.

Next up is expanding the customization so that we can overwrite the rest of the "default" settings manually on a line-by-line basis, if we want.
After that, I'm going to add in #A (active key) activation and keyboard support, for our little popups.

And after that, I'm going to package it all together, say, "Good enough," and call it finished.  (Unless somebody can think of some functionality which they'd like to see the little popup have, that I'm over looking...)

At the current rate which I get to play around with the PC and work on things, this little project should be "finished" by Monday or Tuesday.  (I think.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Marked as best answer by SMcNeill on July 05, 2020, 03:08:23 AM

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2594
    • Steve’s QB64 Archive Forum
Re: Pop Up Menu
« Reply #13 on: July 04, 2020, 10:45:22 PM »
We now have custom line highlight ability, as well as the ability to use the keyboard with our popup menus.

Code: QB64: [Select]
  1. CONST LeftJustify = -1, CenterJustify = 0, RightJustify = 1
  2.  
  3. TYPE menu_type
  4.     Handle AS INTEGER
  5.     Xpos AS INTEGER
  6.     Ypos AS INTEGER
  7.     Visible AS INTEGER
  8.     NumOptions AS INTEGER
  9.     BackGround AS _INTEGER64 'backgroundcolor
  10.     TextColor AS _UNSIGNED LONG 'default color of our text
  11.     HighlightColor AS _INTEGER64 'default color of the highlighted selection row
  12.     ActiveColor AS _UNSIGNED LONG 'default color of the Active Hotkey characters
  13.     BorderSize AS INTEGER
  14.     BorderColor AS _UNSIGNED LONG
  15.     Justify AS INTEGER '-1 = LeftJustify, 0 = CenterJustify, 1 = RightJustify Justify text
  16.     Font AS INTEGER
  17.  
  18. DIM SHARED Menu(1 TO 100) AS menu_type
  19. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
  20.  
  21. SCREEN _NEWIMAGE(640, 480, 32)
  22.  
  23. MainMenu = RegisterMenu
  24. SunShine = _LOADIMAGE("sunshine.png", 32)
  25. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
  26. SetMenuText MainMenu, LeftJustify, White, &H77FFFF00&&
  27. SetMenuFont MainMenu, "c:\windows\fonts\cour.ttf", 20
  28.  
  29. AddOption MainMenu, "#AiFile"
  30. AddOption MainMenu, "#L#AEEdit"
  31. AddOption MainMenu, "#C#AVView"
  32. AddOption MainMenu, "#R#ASSearch"
  33. AddOption MainMenu, "---" 'a divider
  34. AddOption MainMenu, "#L#TFF00FF00#ARRun"
  35. AddOption MainMenu, "#AOOptions"
  36. AddOption MainMenu, "---" 'a divider
  37. AddOption MainMenu, "#HFFFF0000#AHHelp"
  38.  
  39.  
  40. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for LeftJustify/CenterJustify/RightJustify
  41.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'RightJustify mouse was up, then down (clicked)
  42.         RMB = -1
  43.     ELSE
  44.         RMB = 0
  45.     END IF
  46.     IF RMB THEN
  47.         result$ = CheckMenu(MainMenu)
  48.         PRINT result$
  49.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
  50.         SetMenuText MainMenu, Justify, White, &H77FFFF00&&
  51.     END IF
  52.     _LIMIT 30
  53.     _DISPLAY
  54.     RMB = _MOUSEBUTTON(2)
  55.  
  56.  
  57.  
  58.  
  59.  
  60. FUNCTION RegisterMenu
  61.     FOR i = 1 TO 100
  62.         IF Menu(i).Handle = 0 THEN
  63.             ClearMenu i 'make certain all old options are erased and blank
  64.             Menu(i).Handle = i
  65.             RegisterMenu = i 'assign a free handle to create a menu
  66.             EXIT FUNCTION
  67.         END IF
  68.     NEXT
  69. END FUNCTION 'Return 0 if there's no open menu handles to work with
  70.  
  71. SUB ClearMenu (Handle AS INTEGER)
  72.     Menu(Handle).Handle = 0
  73.     Menu(Handle).Xpos = 0
  74.     Menu(Handle).Ypos = 0
  75.     Menu(Handle).Visible = 0
  76.     Menu(Handle).NumOptions = 0
  77.     Menu(Handle).BackGround = &HFF000000&&
  78.     Menu(Handle).TextColor = &HFFFFFFFF&&
  79.     Menu(Handle).Justify = -1 'LeftJustify justify by default
  80.     Menu(Handle).HighlightColor = &H99FFFF00&&
  81.     Menu(Handle).Font = 16
  82.     Menu(Handle).ActiveColor = &HFFFF00FF~&
  83.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
  84.  
  85. SUB AddOption (Handle AS INTEGER, Options$)
  86.     FOR j = 1 TO 100
  87.         IF Options(Handle, j) = "" THEN
  88.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
  89.             Options(Handle, j) = Options$
  90.             EXIT SUB
  91.         END IF
  92.     NEXT
  93.  
  94. SUB SetMenuText (Handle AS INTEGER, Justify AS