QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on July 02, 2020, 04:31:33 am

Title: Pop Up Menu
Post by: SMcNeill 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 [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]) 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. END TYPE
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.  
18.  
19.  
20. $COLOR:32
21. SCREEN _NEWIMAGE(640, 480, 32)
22.  
23. MainMenu = RegisterMenu
24. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
25.  
26.  
27. AddOption MainMenu, "File"
28. AddOption MainMenu, "Edit"
29. AddOption MainMenu, "View"
30. AddOption MainMenu, "Search"
31. AddOption MainMenu, "---" 'a divider
32. AddOption MainMenu, "Run"
33. AddOption MainMenu, "Options"
34. AddOption MainMenu, "---" 'a divider
35. AddOption MainMenu, "Help"
36.  
37.  
38. DO
39.     WHILE _MOUSEINPUT: WEND
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.     END IF
49.     _LIMIT 30
50.     _DISPLAY
51.     RMB = _MOUSEBUTTON(2)
52. LOOP UNTIL _KEYDOWN(27)
53. _DELAY .5
54. SYSTEM
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.  
67.             EXIT FUNCTION
68.         END IF
69.     NEXT
70. END FUNCTION 'Return 0 if there's no open menu handles to work with
71.  
72. SUB ClearMenu (Handle AS INTEGER)
73.     Menu(Handle).Handle = 0
74.     Menu(Handle).Xpos = 0
75.     Menu(Handle).Ypos = 0
76.     Menu(Handle).Visible = 0
77.     Menu(Handle).NumOptions = 0
78.     Menu(Handle).BackGround = &HFF000000&&
79.     Menu(Handle).TextColor = &HFFFFFFFF&&
80.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
81. END SUB
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. END SUB
92.  
93. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
94.     Menu(Handle).BackGround = Background
95.     Menu(Handle).BorderSize = Bordersize
96.     Menu(Handle).BorderColor = BorderColor
97. END SUB
98.  
99. FUNCTION CheckMenu (Handle)
100.     DIM DC AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
101.     DIM Blend AS LONG, Display AS LONG
102.     DIM Dest AS LONG, Source AS LONG
103.  
104.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
105.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
106.  
107.     TempScreen = _COPYIMAGE(0)
108.     DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
109.     Blend = _BLEND: Display = _AUTODISPLAY
110.     Dest = _DEST: Source = _SOURCE
111.  
112.  
113.     Menu(Handle).Xpos = _MOUSEX
114.     Menu(Handle).Ypos = _MOUSEY
115.     X = Menu(Handle).Xpos
116.     Y = Menu(Handle).Ypos
117.  
118.  
119.     'calculate printwidth and printheight
120.     FOR i = 1 TO Menu(Handle).NumOptions
121.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
122.     NEXT
123.     pw = pw + 2 * _FONTWIDTH 'a border around either side
124.     ph = _FONTHEIGHT * (i - 1)
125.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
126.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
127.  
128.  
129.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
130.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
131.     ELSE 'use an image as the backdrop to the menu
132.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
133.     END IF
134.     FOR i = 1 TO Menu(Handle).BorderSize
135.         j = i - 1
136.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
137.     NEXT
138.  
139.     COLOR Menu(Handle).TextColor, 0
140.     FOR i = 1 TO Menu(Handle).NumOptions
141.         Caption$ = Options(Handle, i)
142.         IF Caption$ = "---" THEN
143.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
144.         ELSE
145.             _PRINTSTRING (X + _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), Caption$
146.         END IF
147.     NEXT
148.  
149.     MenuScreen = _COPYIMAGE(0)
150.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
151.     DO
152.         _DONTBLEND
153.         _PUTIMAGE (0, 0), MenuScreen
154.         _BLEND
155.         WHILE _MOUSEINPUT: WEND
156.         MX = _MOUSEX: MY = _MOUSEY
157.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
158.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
159.             IF Options(Handle, Where) <> "---" THEN
160.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
161.                     CheckMenu = Where
162.                     done = -1
163.                 END IF
164.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
165.                     CheckMenu = 1000 + Where
166.                     done = -1
167.                 END IF
168.             END IF
169.         ELSE 'we clicked outside the designated menu area
170.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
171.                 done = -1
172.             END IF
173.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
174.                 done = -1
175.             END IF
176.         END IF
177.         _LIMIT 30
178.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
179.         _DISPLAY
180.     LOOP UNTIL done
181.  
182.     _DONTBLEND
183.     _FREEIMAGE MenuScreen
184.     _PUTIMAGE , TempScreen, 0
185.     _FREEIMAGE TempScreen
186.     COLOR DC, BG
187.     IF Blend THEN _BLEND ELSE _DONTBLEND
188.     IF Display THEN _DISPLAY ELSE _AUTODISPLAY
189.     _DEST Dest: _SOURCE Source
190. END SUB
191.  
192.  

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.  ;)

Title: Re: Pop Up Menu
Post by: OldMoses 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...

Title: Re: Pop Up Menu
Post by: SMcNeill 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...  ;)

Title: Re: Pop Up Menu
Post by: SMcNeill 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. END TYPE
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. $COLOR:32
20. SCREEN _NEWIMAGE(640, 480, 32)
21.  
22. MainMenu = RegisterMenu
23. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
24.  
25.  
26. AddOption MainMenu, "File"
27. AddOption MainMenu, "Edit"
28. AddOption MainMenu, "View"
29. AddOption MainMenu, "Search"
30. AddOption MainMenu, "---" 'a divider
31. AddOption MainMenu, "Run"
32. AddOption MainMenu, "Options"
33. AddOption MainMenu, "---" 'a divider
34. AddOption MainMenu, "Help"
35.  
36.  
37. DO
38.     WHILE _MOUSEINPUT: WEND
39.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'right mouse was up, then down (clicked)
40.         RMB = -1
41.     ELSE
42.         RMB = 0
43.     END IF
44.     IF RMB THEN
45.         result$ = CheckMenu(MainMenu)
46.         PRINT result$
47.     END IF
48.     _LIMIT 30
49.     _DISPLAY
50.     RMB = _MOUSEBUTTON(2)
51. LOOP UNTIL _KEYDOWN(27)
52. _DELAY .5
53. SYSTEM
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.  
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.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
80. END SUB
81.  
82. SUB AddOption (Handle AS INTEGER, Options$)
83.     FOR j = 1 TO 100
84.         IF Options(Handle, j) = "" THEN
85.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
86.             Options(Handle, j) = Options$
87.             EXIT SUB
88.         END IF
89.     NEXT
90. END SUB
91.  
92. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
93.     Menu(Handle).BackGround = Background
94.     Menu(Handle).BorderSize = Bordersize
95.     Menu(Handle).BorderColor = BorderColor
96. END SUB
97.  
98. FUNCTION CheckMenu$ (Handle)
99.     DIM DC AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
100.     DIM Blend AS LONG, Display AS LONG
101.     DIM Dest AS LONG, Source AS LONG
102.  
103.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
104.     IF _FONTWIDTH = 0 THEN EXIT SUB 'not made for variable width fonts, at this time.
105.  
106.     TempScreen = _COPYIMAGE(0)
107.     DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
108.     Blend = _BLEND: Display = _AUTODISPLAY
109.     Dest = _DEST: Source = _SOURCE
110.  
111.  
112.     Menu(Handle).Xpos = _MOUSEX
113.     Menu(Handle).Ypos = _MOUSEY
114.     X = Menu(Handle).Xpos
115.     Y = Menu(Handle).Ypos
116.  
117.  
118.     'calculate printwidth and printheight
119.     FOR i = 1 TO Menu(Handle).NumOptions
120.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
121.     NEXT
122.     pw = pw + 2 * _FONTWIDTH 'a border around either side
123.     ph = _FONTHEIGHT * (i - 1)
124.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
125.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
126.  
127.  
128.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
129.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
130.     ELSE 'use an image as the backdrop to the menu
131.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
132.     END IF
133.     FOR i = 1 TO Menu(Handle).BorderSize
134.         j = i - 1
135.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
136.     NEXT
137.  
138.     COLOR Menu(Handle).TextColor, 0
139.     FOR i = 1 TO Menu(Handle).NumOptions
140.         Caption$ = Options(Handle, i)
141.         IF Caption$ = "---" THEN
142.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
143.         ELSE
144.             _PRINTSTRING (X + _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), Caption$
145.         END IF
146.     NEXT
147.  
148.     MenuScreen = _COPYIMAGE(0)
149.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
150.     DO
151.         _DONTBLEND
152.         _PUTIMAGE (0, 0), MenuScreen
153.         _BLEND
154.         WHILE _MOUSEINPUT: WEND
155.         MX = _MOUSEX: MY = _MOUSEY
156.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
157.             Where = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
158.             IF Options(Handle, Where) <> "---" THEN
159.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
160.                     CheckMenu$ = LCASE$(Options(Handle, Where))
161.                     done = -1
162.                 END IF
163.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
164.                     CheckMenu$ = UCASE$(Options(Handle, Where))
165.                     done = -1
166.                 END IF
167.             END IF
168.         ELSE 'we clicked outside the designated menu area
169.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a left click style event
170.                 done = -1
171.             END IF
172.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a right click style event
173.                 done = -1
174.             END IF
175.         END IF
176.         _LIMIT 30
177.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
178.         _DISPLAY
179.     LOOP UNTIL done
180.  
181.     _DONTBLEND
182.     _FREEIMAGE MenuScreen
183.     _PUTIMAGE , TempScreen, 0
184.     _FREEIMAGE TempScreen
185.     COLOR DC, BG
186.     IF Blend THEN _BLEND ELSE _DONTBLEND
187.     IF Display THEN _DISPLAY ELSE _AUTODISPLAY
188.     _DEST Dest: _SOURCE Source
189. END SUB
190.  

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.  :)

Title: Re: Pop Up Menu
Post by: OldMoses 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.

Title: Re: Pop Up Menu
Post by: bplus on July 02, 2020, 05:29:53 pm

Yes I am admiring the number of lines of code too.

Title: Re: Pop Up Menu
Post by: SMcNeill on July 02, 2020, 06:01:20 pm

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

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.)

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

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.)

Title: Re: Pop Up Menu
Post by: Richard 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.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/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

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

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.)

Title: Re: Pop Up Menu
Post by: OldMoses 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.

Title: Re: Pop Up Menu
Post by: SMcNeill on July 04, 2020, 01:33:36 pm

Quote from: OldMoses 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.

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

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

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.)

Title: Re: Pop Up Menu
Post by: SMcNeill 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. END TYPE
18.  
19. DIM SHARED Menu(1 TO 100) AS menu_type
20. DIM SHARED Options(1 TO 100, 1 TO 100) AS STRING 'menu captions.. fist value is the menu number, second value is the captions
21.  
22. $COLOR:32
23. SCREEN _NEWIMAGE(640, 480, 32)
24.  
25. MainMenu = RegisterMenu
26. SunShine = _LOADIMAGE("sunshine.png", 32)
27. SetMenuBackground MainMenu, Blue, 2, Silver 'blue background with 2 pixel wide silver border
28. SetMenuText MainMenu, LeftJustify, White, &H77FFFF00&&
29. SetMenuFont MainMenu, "c:\windows\fonts\cour.ttf", 20
30.  
31. AddOption MainMenu, "#AiFile"
32. AddOption MainMenu, "#L#AEEdit"
33. AddOption MainMenu, "#C#AVView"
34. AddOption MainMenu, "#R#ASSearch"
35. AddOption MainMenu, "---" 'a divider
36. AddOption MainMenu, "#L#TFF00FF00#ARRun"
37. AddOption MainMenu, "#AOOptions"
38. AddOption MainMenu, "---" 'a divider
39. AddOption MainMenu, "#HFFFF0000#AHHelp"
40.  
41.  
42. Justify = -1 'Just a variable we can use to showcase how we can now justify our captions positions for LeftJustify/CenterJustify/RightJustify
43. DO
44.     WHILE _MOUSEINPUT: WEND
45.     IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'RightJustify 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.         Justify = Justify + 1: IF Justify = 2 THEN Justify = -1
54.         SetMenuText MainMenu, Justify, White, &H77FFFF00&&
55.     END IF
56.     _LIMIT 30
57.     _DISPLAY
58.     RMB = _MOUSEBUTTON(2)
59. LOOP UNTIL _KEYDOWN(27)
60. _DELAY .5
61. SYSTEM
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.             EXIT FUNCTION
74.         END IF
75.     NEXT
76. END FUNCTION 'Return 0 if there's no open menu handles to work with
77.  
78. SUB ClearMenu (Handle AS INTEGER)
79.     Menu(Handle).Handle = 0
80.     Menu(Handle).Xpos = 0
81.     Menu(Handle).Ypos = 0
82.     Menu(Handle).Visible = 0
83.     Menu(Handle).NumOptions = 0
84.     Menu(Handle).BackGround = &HFF000000&&
85.     Menu(Handle).TextColor = &HFFFFFFFF&&
86.     Menu(Handle).Justify = -1 'LeftJustify justify by default
87.     Menu(Handle).HighlightColor = &H99FFFF00&&
88.     Menu(Handle).Font = 16
89.     Menu(Handle).ActiveColor = &HFFFF00FF~&
90.     FOR j = 1 TO 100: Options(Handle, j) = "": NEXT
91. END SUB
92.  
93. SUB AddOption (Handle AS INTEGER, Options$)
94.     FOR j = 1 TO 100
95.         IF Options(Handle, j) = "" THEN
96.             Menu(Handle).NumOptions = Menu(Handle).NumOptions + 1
97.             Options(Handle, j) = Options$
98.             EXIT SUB
99.         END IF
100.     NEXT
101. END SUB
102.  
103. SUB SetMenuText (Handle AS INTEGER, Justify AS INTEGER, TextColor AS _UNSIGNED LONG, HighlightColor AS _INTEGER64)
104.     Menu(Handle).Justify = Justify
105.     Menu(Handle).TextColor = TextColor
106.     Menu(Handle).HighlightColor = HighlightColor
107. END SUB
108.  
109. SUB SetMenuFont (Handle AS INTEGER, Fontname AS STRING, fontsize AS INTEGER)
110.     f = _LOADFONT(Fontname + CHR$(0), fontsize, "MONOSPACE")
111.     IF f > 0 THEN Menu(Handle).Font = f ELSE Menu(Handle).Font = 16
112.     IF _FONTWIDTH(f) = 0 THEN Menu(Handle).Font = 16
113. END SUB
114.  
115.  
116. SUB SetMenuBackground (Handle AS INTEGER, Background AS _INTEGER64, Bordersize AS INTEGER, BorderColor AS _UNSIGNED LONG)
117.     Menu(Handle).BackGround = Background
118.     Menu(Handle).BorderSize = Bordersize
119.     Menu(Handle).BorderColor = BorderColor
120. END SUB
121.  
122. FUNCTION CheckMenu$ (Handle)
123.     DIM DC AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
124.     DIM Blend AS LONG, Display AS LONG
125.     DIM Dest AS LONG, Source AS LONG
126.     DIM Down AS INTEGER, Right AS INTEGER
127.     DIM HotKey(0 TO 255) AS INTEGER
128.     Font = _FONT: Down = CSRLIN: Right = POS(0)
129.  
130.     IF _PIXELSIZE = 2 THEN EXIT SUB 'not converted to text coordinate system yet.  Graphic screen menus only, at this time
131.     _KEYCLEAR
132.     TempScreen = _COPYIMAGE(0)
133.     DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
134.     Blend = _BLEND: Display = _AUTODISPLAY
135.     Dest = _DEST: Source = _SOURCE
136.     _FONT Menu(Handle).Font
137.  
138.     IF _FONTWIDTH = 0 THEN CLS: PRINT "KABOOOOM!": END
139.     Menu(Handle).Xpos = _MOUSEX
140.     Menu(Handle).Ypos = _MOUSEY
141.     X = Menu(Handle).Xpos
142.     Y = Menu(Handle).Ypos
143.  
144.  
145.     'calculate printwidth and printheight
146.     FOR i = 1 TO Menu(Handle).NumOptions
147.         IF pw < _PRINTWIDTH(Options(Handle, i)) THEN pw = _PRINTWIDTH(Options(Handle, i))
148.     NEXT
149.     ow = pw 'original width
150.     pw = pw + 2 * _FONTWIDTH 'a border around either side
151.     ph = _FONTHEIGHT * (i - 1)
152.     IF X + pw + Menu(Handle).BorderSize > _WIDTH THEN X = _WIDTH - pw - Menu(Handle).BorderSize
153.     IF Y + ph + Menu(Handle).BorderSize > _HEIGHT THEN Y = _HEIGHT - ph - Menu(Handle).BorderSize
154.  
155.  
156.     IF Menu(Handle).BackGround > -1 THEN 'use a solid color as the backdrop to the menu
157.         LINE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround, BF
158.     ELSE 'use an image as the backdrop to the menu
159.         _PUTIMAGE (X, Y)-STEP(pw, ph), Menu(Handle).BackGround
160.     END IF
161.  
162.     FOR i = 1 TO Menu(Handle).BorderSize
163.         j = i - 1
164.         LINE (X - j, Y - j)-STEP(pw + j * 2, ph + j * 2), Menu(Handle).BorderColor, B
165.     NEXT
166.  
167.     COLOR Menu(Handle).TextColor, 0
168.     FOR i = 1 TO Menu(Handle).NumOptions
169.         GOSUB getsettings
170.         IF Caption$ = "---" THEN
171.             LINE (X, Y + (i - .5) * _FONTHEIGHT - Menu(Handle).BorderSize \ 2)-STEP(pw, Menu(Handle).BorderSize), Menu(Handle).BorderColor, BF
172.         ELSE
173.             _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
174.         END IF
175.         COLOR ActiveColor&&, 0
176.         FOR j = 0 TO 255
177.             IF HotKey(j) = i THEN
178.                 p = INSTR(Caption$, CHR$(j))
179.                 _PRINTSTRING (X + offset + p * _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), CHR$(j)
180.             END IF
181.         NEXT
182.     NEXT
183.  
184.  
185.  
186.     MenuScreen = _COPYIMAGE(0)
187.     LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
188.     DO
189.         _DONTBLEND
190.         _PUTIMAGE (0, 0), MenuScreen
191.         _BLEND
192.         WHILE _MOUSEINPUT: WEND
193.         MX = _MOUSEX: MY = _MOUSEY
194.         IF MX >= X AND MX <= X + pw AND MY >= Y AND MY <= Y + ph THEN 'the mouse is inside the menu area
195.             i = (MY - Y) \ _FONTHEIGHT + 1 'Which menu index are we currently hovering over?
196.             GOSUB getsettings
197.  
198.             IF Caption$ <> "---" THEN
199.                 IF HighlightColor&& > -1 THEN 'use a solid color as the highlight to the current menu choice
200.                     LINE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), HighlightColor&&, BF
201.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + _FONTHEIGHT * (i - 1)), Caption$
202.                 ELSE 'use an image as the backdrop to the menu highlight
203.                     _PUTIMAGE (X, Y + (i - 1) * _FONTHEIGHT)-STEP(pw, _FONTHEIGHT), HighlightColor&&
204.                     _PRINTSTRING (X + _FONTWIDTH + offset, Y + i * _FONTHEIGHT), Caption$
205.                 END IF
206.                 COLOR ActiveColor&&, 0
207.                 FOR j = 0 TO 255
208.                     IF HotKey(j) = i THEN
209.                         p = INSTR(Caption$, CHR$(j))
210.                         _PRINTSTRING (X + offset + p * _FONTWIDTH, Y + _FONTHEIGHT * (i - 1)), CHR$(j)
211.                     END IF
212.                 NEXT
213.  
214.  
215.                 IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
216.                     CheckMenu$ = LCASE$(Options(Handle, i))
217.                     done = -1
218.                 END IF
219.                 IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
220.                     CheckMenu$ = UCASE$(Options(Handle, i))
221.                     done = -1
222.                 END IF
223.             END IF
224.         ELSE 'we clicked outside the designated menu area
225.             IF LMB = 0 AND _MOUSEBUTTON(1) THEN 'it's a LeftJustify click style event
226.                 done = -1
227.             END IF
228.             IF RMB = 0 AND _MOUSEBUTTON(2) THEN 'it's a RightJustify click style event
229.                 done = -1
230.             END IF
231.         END IF
232.  
233.         k = _KEYHIT
234.         IF k > 0 AND k < 255 THEN
235.             IF HotKey(k) THEN CheckMenu = Options(Handle, HotKey(k)): done = -1
236.         END IF
237.         _LIMIT 30
238.         LMB = _MOUSEBUTTON(1): RMB = _MOUSEBUTTON(2)
239.         _DISPLAY
240.     LOOP UNTIL done
241.  
242.     DO 'strip off any of the command formatting from our return value
243.         temp$ = GetCommand$(CheckMenu$)
244.     LOOP UNTIL temp$ = ""
245.  
246.  
247.     _DONTBLEND
248.     _FREEIMAGE MenuScreen
249.     _PUTIMAGE , TempScreen, 0
250.     _FREEIMAGE TempScreen
251.     COLOR DC, BG
252.     IF Blend THEN _BLEND ELSE _DONTBLEND
253.     IF Display THEN _DISPLAY ELSE _AUTODISPLAY
254.     _DEST Dest: _SOURCE Source
255.     _FONT Font: LOCATE Down, Right
256.  
257.     EXIT FUNCTION
258.  
259.     getsettings: 'Get the default settings, and then modify them (if needed) according to our command line options
260.  
261.     justify = Menu(Handle).Justify 'get the default justification setting
262.     textcolor&& = Menu(Handle).TextColor 'the default color for our text
263.     HighlightColor&& = Menu(Handle).HighlightColor 'the default color for the line highlight
264.     ActiveColor&& = Menu(Handle).ActiveColor
265.  
266.     'And then parse any custom line-by-line settings from command lines
267.  
268.     Caption$ = Options(Handle, i)
269.     DO
270.         Com$ = GetCommand$(Caption$)
271.         SELECT CASE UCASE$(LEFT$(Com$, 2))
272.             CASE "#L": justify = -1
273.             CASE "#C": justify = 0
274.             CASE "#R": justify = 1
275.             CASE "#T": textcolor&& = VAL("&H" + MID$(Com$, 3) + "&&")
276.             CASE "#H": HighlightColor&& = VAL("&H" + MID$(Com$, 3) + "&&")
277.             CASE "#A": HotKey(ASC(Com$, 3)) = i
278.         END SELECT
279.     LOOP UNTIL Com$ = ""
280.  
281.     SELECT CASE justify
282.         CASE -1: offset = 0 'LeftJustify justify
283.         CASE 0: offset = (ow - _PRINTWIDTH(Caption$)) \ 2 'CenterJustify
284.         CASE 1: offset = ow - _PRINTWIDTH(Caption$) 'RightJustify justify
285.     END SELECT
286.     COLOR textcolor&&, 0
287.  
288.     RETURN
289. END SUB
290.  
291. FUNCTION GetCommand$ (Caption$)
292.     SELECT CASE UCASE$(LEFT$(Caption$, 2))
293.         CASE "#L", "#R", "#C"
294.             GetCommand$ = LEFT$(Caption$, 2)
295.             Caption$ = MID$(Caption$, 3)
296.         CASE "#H", "#T"
297.             GetCommand$ = LEFT$(Caption$, 10)
298.             Caption$ = MID$(Caption$, 11)
299.         CASE "#A"
300.             GetCommand$ = LEFT$(Caption$, 3)
301.             Caption$ = MID$(Caption$, 4)
302.         CASE ELSE
303.             'return a null string and don't change caption$
304.     END SELECT
305. END FUNCTION

This is about as simple as I can imagine it being, while allowing us all the flexibility and customization that it does, for a popup menu.

Using it shouldn't be hard for anyone, as long as they either keep the MMCL syntax in mind, or else never bother to make use of it.

Mini-Menu Command Language format, for our menu options are:
#L -- left justify
#R -- right justify
#C -- center
#Hvvvvvvvv -- set the color value for the line highlight.  (Hex value for Alpha, Red, Green Blue)
#Tvvvvvvvv -- set the color value for the option text.
#Av -- set the ASCII value for the active hotkey for the menu.

Note: I'm keeping this fairly simple, so the routine expects your menu option to contain the ASCII character you're using for a hotkey.  In other words, don't choose a menu item called Files and then choose a hotkey of "@" for it.  You'll end up with some weird display glitches like that...

Note 2: Hotkeys *ARE* case sensitive.  So if you have Files with that "F" as the hotkey, then the keyboard input expects that you would hit a capital "F" to select that option.  Lowercase "f" won't trigger the option.  This is intentional and not a glitch, as it allows us to use both "F" and "f" as valid hotkeys to select between two different options.

Text Only | Text with Attachments