File Menu

[Dav]

Hi Ken.  Here's the 1st right click menu thing I posted on [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there].  It's far from the best out there, but it's easy to add to a program.  I need to update it to handle the mouse better, and other stuff.

- Dav

Code: QB64: [Select]

1. '====================
2. 'RIGHT-CLICK-MENU.BAS
3. '====================
4. 'User defined Right click Popup Menu.
5. 'Menu created on mouse x/y position.
6. 'Easy to add to your programs.
7. 'Coded by Dav JULY/2013
8.  
9.  
10. '=== =============DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT ==========================
11. DECLARE FUNCTION RightClickMenu% ()
12.  
13. DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
14. DIM SHARED RightClickList$(1 TO RightClickItems)
15.  
16. RightClickList$(1) = "New" '     <------------ List all your menu items here
17. RightClickList$(2) = "Open..."
18. RightClickList$(3) = "-Save" '   <------------ Make it a Disabled Item (-)
19. RightClickList$(4) = "Save As..."
20. RightClickList$(5) = "---" '     <------------ This means it's a separator (---)
21. RightClickList$(6) = "Settings..."
22. RightClickList$(7) = "About"
23. RightClickList$(8) = "---" '     <------------ (another separator)
24. RightClickList$(9) = "Exit"
25.  
26. '========================================================================================
27.  
28.  
29. '=== Demo follows....
30.  
31. SCREEN _NEWIMAGE(640, 480, 32)
32.  
33. PAINT (0, 0), _RGB(33, 66, 99)
34.  
35. '=== draw stuff
36. FOR x = 25 TO 610 STEP 3
37.     FOR y = 25 TO 300 STEP 3
38.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
39.     NEXT
40. NEXT
41.  
42. LOCATE 24, 24: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
43. PRINT "Right Click Anywhere for Popup menu."
44. LOCATE 25, 30: PRINT "Select EXIT to quit."
45.  
46. DO
47.  
48.     a% = RightClickMenu% ' <----- Check for rightclick menu
49.  
50.     '=== what did you select?
51.     IF a% > 0 THEN
52.         COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
53.         LOCATE 21, 25: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
54.     END IF
55.  
56. LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...
57.  
58. END
59.  
60.  
61.  
62. '================================================================================
63. '================================================================================
64. '================================================================================
65. FUNCTION RightClickMenu% ()
66.  
67. 'Returns 0 if nothing selected, else return number of item selected.
68. 'Requires RightClickList$ array defined.
69.  
70. Cheese = _MOUSEINPUT
71.  
72. IF _MOUSEBUTTON(2) THEN
73.  
74.     Row = FIX(_MOUSEY / 16): Col = FIX(_MOUSEX / 8)
75.  
76.     x = Col * 8 - 8: y = Row * 16 - 16
77.  
78.     '=== Compute BoxWidth based on longest menu item string length
79.     BoxWidth = 0
80.     FOR t = 1 TO RightClickItems
81.         temp = LEN(RightClickList$(t))
82.         IF LEFT$(RightClickList$(t), 1) = "-" THEN temp = temp - 1
83.         IF temp > BoxWidth THEN BoxWidth = temp
84.     NEXT: BoxWidth = BoxWidth * 8
85.  
86.     '=== Compute BoxHeight based on num of menu items
87.     BoxHeight = RightClickItems * 16
88.  
89.     '===== Make sure Mouse not too close to edge of screen
90.     '===== If it is, Adjust x & y position here, move in closer...
91.     IF _MOUSEX < 20 THEN
92.         Col = 3: x = Col * 8 - 8:
93.     END IF
94.     IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
95.         xm = _WIDTH - (BoxWidth + 10)
96.         Col = FIX(xm / 8): x = Col * 8 - 8:
97.     END IF
98.     IF _MOUSEY < 20 THEN
99.         Row = 2: y = Row * 16 - 16
100.     END IF
101.     IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
102.         xy = _HEIGHT - (BoxHeight + 10)
103.         Row = FIX(xy / 16): y = Row * 16 - 16
104.     END IF
105.  
106.     FirstRow = Row - 1
107.  
108.     '=== copy screen using _mem (thanks Steve!)
109.     DIM m AS _MEM, n AS _MEM
110.     m = _MEMIMAGE(0)
111.     n = _MEMNEW(m.SIZE)
112.     _MEMCOPY m, m.OFFSET, m.SIZE TO n, n.OFFSET
113.  
114.     '=== trap until buttons up
115.     DO
116.         nibble = _MOUSEINPUT
117.     LOOP UNTIL NOT _MOUSEBUTTON(2)
118.  
119.     '=== Draw Box (10 pix padding)
120.     LINE (x - 10, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
121.     LINE (x + 10 + BoxWidth, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
122.     LINE (x - 10, y + 10 + BoxHeight)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
123.     LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
124.     LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
125.     LINE (x + 9 + BoxWidth, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
126.     LINE (x - 9, y + 9 + BoxHeight)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
127.  
128.     DO
129.         Cheese = _MOUSEINPUT
130.  
131.         '=== if in bounds of menu space
132.         IF _MOUSEX > x AND _MOUSEX < x + BoxWidth AND _MOUSEY > y AND _MOUSEY < y + BoxHeight THEN
133.  
134.             '=== Draw items
135.             IF CurRow <> FIX(_MOUSEY / 16) THEN
136.                 COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
137.                 FOR t = 0 TO RightClickItems - 1
138.                     IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
139.                         'Draw highlight box...
140.                         COLOR _RGB(255, 255, 255), _RGB(8, 36, 107)
141.                     ELSE
142.                         IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
143.                             COLOR _RGB(130, 130, 130), _RGB(214, 211, 206)
144.                         ELSE
145.                             COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
146.                         END IF
147.                     END IF
148.                     padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
149.                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme - 1
150.                     IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
151.                     LOCATE Row + t, Col - 1
152.                     IF RightClickList$(t + 1) = "---" THEN
153.                         COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
154.                         PRINT STRING$((BoxWidth / 8) + 2, 196);
155.                     ELSE
156.                         IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
157.                             PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
158.                         ELSE
159.                             PRINT " "; RightClickList$(t + 1); pad$; " ";
160.                         END IF
161.                     END IF
162.                 NEXT
163.             END IF
164.  
165.             IF _MOUSEBUTTON(1) THEN
166.                 sel = FIX(_MOUSEY / 16) - FirstRow + 1
167.                 'only select if not a seperator and not disabled
168.                 IF RightClickList$(sel) <> "---" THEN
169.                     IF LEFT$(RightClickList$(sel), 1) <> "-" THEN
170.                         RightClickMenu% = sel: EXIT DO
171.                     END IF
172.                 END IF
173.             END IF
174.  
175.             IF _MOUSEBUTTON(2) THEN EXIT DO
176.  
177.         ELSE
178.  
179.             '=== Draw items
180.             IF FIX(_MOUSEY / 16) <> CurRow THEN
181.                 FOR t = 0 TO RightClickItems - 1
182.                     padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
183.                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme - 1
184.                     IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
185.                     LOCATE Row + t, Col - 1
186.                     IF RightClickList$(t + 1) = "---" THEN
187.                         COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
188.                         PRINT STRING$((BoxWidth / 8) + 2, 196);
189.                     ELSE
190.  
191.                         IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
192.                             COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
193.                             PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
194.                         ELSE
195.                             COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
196.                             PRINT " "; RightClickList$(t + 1); pad$; " ";
197.                         END IF
198.  
199.                     END IF
200.                 NEXT
201.             END IF
202.  
203.             IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO
204.  
205.         END IF
206.  
207.         '=== Mark current row mouse is in
208.         CurRow = FIX(_MOUSEY / 16)
209.  
210.     LOOP
211.  
212.     '=== restore screen
213.     _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
214.     _MEMFREE m: _MEMFREE n
215.  
216. END IF
217.  
218. END FUNCTION
219. '================================================================================
220. '================================================================================
221. '================================================================================
222.  

[bplus]

Oh that's nice @Dav

I'm akeep'n that one!

[SierraKen]

This is totally awesome Dav!!! Thank you!!! I got it working in Paint Pixels 8. It's not completely done but I know how to finish the menu. :))) Thanks tons! I'll put your name in the Comments.

[SMcNeill]

Here's my little pop-up circle menu, which I thought I'd toss out just for fun.  I just wanted something a little different when I came up with this idea, since Dav and I had already created square popup menus.  I don't think this is the one Dav was asking about, but it's more or less the one which I'd had in my old IDE for playing around with as a "quick access menu".  I'll have to dig around to see if I can find my other one somewhere, but maybe Ken will get inspired by this oddity to think outside the box and see if he can come up with a menu/selection system which suits his own unique style of coding.  ;)

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(1024, 720, 32)
2. _DELAY .25
3. _SCREENMOVE _MIDDLE
4.  
5. COLOR -1
6.  
7. DO
8.     DO
9.         MScroll = MScroll + _MOUSEWHEEL
10.     LOOP WHILE _MOUSEINPUT
11.     IF RMB = 0 AND _MOUSEBUTTON(2) = 0 THEN RMB = 1
12.     IF RMB AND _MOUSEBUTTON(2) THEN
13.         Menu = 1 'if the rmb is ready and we click the right mouse, then open the main menu
14.         MX = _MOUSEX: MY = _MOUSEY
15.     END IF
16.  
17.     _LIMIT 30
18.     IF Menu > 0 THEN
19.         Result = DrawMenu(Menu, MX, MY)
20.         IF Result > -1 THEN '-1 says we moved/clicked off the menu area
21.             PRINT Menu * 100 + Result 'Show how to get an unique menu result with simple math
22.             SELECT CASE Menu
23.                 CASE 1 'main menu
24.                     SELECT CASE Result 'what do we do if someone clicks on the main menu?
25.                         CASE 0: Menu = 0: 'we close the main menu; do nothing
26.                         CASE 1: Menu = 2 'we open the files menu
27.                         CASE 2: Menu = 3 'we open the edit menu
28.                         CASE 3: Menu = 4 'we open the run menu
29.                         CASE 4: Menu = 5 'we open the Do More menu
30.                         CASE 5: Menu = 0 'we open the Help options (which we don't actually do here)
31.                     END SELECT
32.                 CASE ELSE 'I'm actually not doing anything but closing the menus, as this is just a quick demo
33.                     Menu = 0 'menu 0 closes the menus
34.             END SELECT
35.         ELSE
36.             Menu = 0 'menu 0 closes the menus
37.         END IF
38.         _DISPLAY
39.     END IF
40. LOOP
41.  
42. FUNCTION DrawMenu% (Menu AS _BYTE, x AS INTEGER, y AS INTEGER)
43.     DIM DC AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
44.     SELECT CASE Menu
45.         CASE 1:
46.             REDIM menu(5) AS STRING
47.             menu(0) = "Exit"
48.             menu(1) = "File"
49.             menu(2) = "Edit"
50.             menu(3) = "Run"
51.             menu(4) = "Do More"
52.             menu(5) = "Help"
53.         CASE 2
54.             REDIM menu(5) AS STRING
55.             menu(0) = "Main"
56.             menu(1) = "New"
57.             menu(2) = "Open"
58.             menu(3) = "Save"
59.             menu(4) = "Save As"
60.             menu(5) = "Exit"
61.         CASE 3
62.             REDIM menu(4) AS STRING
63.             menu(0) = "Main"
64.             menu(1) = "Undo"
65.             menu(2) = "Redo"
66.             menu(3) = "Syntax"
67.             menu(4) = "GoTo"
68.         CASE 4
69.             REDIM menu(3) AS STRING
70.             menu(0) = "Main"
71.             menu(1) = "Test"
72.             menu(2) = "P-Comp"
73.             menu(3) = "S & Run"
74.         CASE 5
75.             REDIM menu(5) AS STRING
76.             menu(0) = "Main"
77.             menu(1) = "Wiki"
78.             menu(2) = "Forums"
79.             menu(3) = "QB64"
80.             menu(4) = "Chat"
81.             menu(5) = "ASCII"
82.     END SELECT
83.  
84.     IF x < 100 THEN x = 100
85.     IF x > _WIDTH - 100 THEN x = _WIDTH - 100
86.     IF y < 100 THEN y = 100
87.     IF y > _HEIGHT - 100 THEN y = _HEIGHT - 100
88.  
89.  
90.     DrawMenu% = -1
91.  
92.     CONST CirclePI = 6.2831853071795
93.     TYPE Point_Type
94.         x AS INTEGER
95.         y AS INTEGER
96.     END TYPE
97.     DIM Arc AS DOUBLE
98.  
99.     Limit = UBOUND(Menu)
100.     DIM Centers(Limit) AS Point_Type
101.  
102.     DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
103.     PCOPY 0, 1
104.  
105.  
106.     'Draw the whole pop-up first in a black shadow
107.     CircleFill x + 2, y + 2, 100, _RGB32(0, 0, 0)
108.     'Then draw the main work area
109.     CircleFill x, y, 100, _RGBA32(0, 0, 255, 128)
110.     'Next, Divide the circle into quadrants based on how many menu choices we have
111.  
112.     Arc = CirclePI / Limit
113.     FOR i = 1 TO Limit
114.         Centers(i).x = x + 70 * COS(Arc * i)
115.         Centers(i).y = y + 70 * SIN(Arc * i)
116.         'Menu Shadow
117.         CircleFill Centers(i).x + 2, Centers(i).y + 2, 29, _RGB32(0, 0, 0)
118.         'Menu Circle
119.         CircleFill Centers(i).x, Centers(i).y, 29, _RGB32(255, 0, 0)
120.         COLOR _RGB32(255, 255, 255), 0
121.         _PRINTSTRING (Centers(i).x - (_FONTWIDTH * LEN(menu(i)) / 2), Centers(i).y - _FONTHEIGHT / 2), menu(i)
122.     NEXT
123.  
124.     'Center Circle Shadow
125.     CircleFill x + 2, y + 2, 40, _RGB32(0, 0, 0)
126.     'Center Circle
127.     CircleFill x, y, 40, _RGB32(0, 255, 0)
128.     _PRINTSTRING (x - (_FONTWIDTH * LEN(menu(0)) / 2), y - _FONTHEIGHT / 2), menu(0)
129.  
130.  
131.     RMB = 0: LMB = 0
132.     DO
133.         _LIMIT 30
134.         DO: LOOP WHILE _MOUSEINPUT
135.         _DISPLAY
136.  
137.         IF _MOUSEBUTTON(1) = 0 THEN LMB = 1 'make certain left mouse is up before we accept a click
138.         IF _MOUSEBUTTON(2) = 0 THEN RMB = 1 'make certain right mouse is up before we accept a click
139.         FOR i = 1 TO Limit
140.             CX = Centers(i).x: CY = Centers(i).y
141.             IF SQR((_MOUSEX - CX) ^ 2 + (_MOUSEY - CY) ^ 2) < 30 AND LMB AND _MOUSEBUTTON(1) THEN
142.                 'The button is down in a menu area
143.                 DrawMenu% = i: GOTO exitfunction
144.             END IF
145.         NEXT
146.         'Check our special center.  It's bigger than the others.
147.         IF SQR((_MOUSEX - x) ^ 2 + (_MOUSEY - y) ^ 2) <= 40 AND LMB AND _MOUSEBUTTON(1) THEN
148.             DrawMenu% = 0: GOTO exitfunction
149.         END IF
150.         'Check to see if we moved off the pop-up
151.         IF SQR((_MOUSEX - x) ^ 2 + (_MOUSEY - y) ^ 2) > 100 AND LMB OR (RMB AND _MOUSEBUTTON(2)) THEN DrawMenu% = -1: GOTO exitfunction
152.     LOOP
153.  
154.     exitfunction:
155.  
156.     PCOPY 1, 0
157.     COLOR DC, BG
158. END FUNCTION
159.  
160.  
161. SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS LONG)
162.     DIM Radius AS LONG, RadiusError AS LONG
163.     DIM X AS LONG, Y AS LONG
164.  
165.     Radius = ABS(R)
166.     RadiusError = -Radius
167.     X = Radius
168.     Y = 0
169.  
170.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
171.  
172.     ' Draw the middle span here so we don't draw it twice in the main loop,
173.     ' which would be a problem with blending turned on.
174.     LINE (CX - X, CY)-(CX + X, CY), C, BF
175.  
176.     WHILE X > Y
177.         RadiusError = RadiusError + Y * 2 + 1
178.         IF RadiusError >= 0 THEN
179.             IF X <> Y + 1 THEN
180.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
181.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
182.             END IF
183.             X = X - 1
184.             RadiusError = RadiusError - X * 2
185.         END IF
186.         Y = Y + 1
187.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
188.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
189.     WEND
190.  
191. END SUB
192.  

[Dav]

Thanks @bplus and @SierraKen. I'm glad it can be useful.  If I remember right, @SMcNeill  improved it and added larger font (and I like your circle one too, Steve).  I can't find the 2nd version which had different menu styles and color schemes - it may be lost.   I'll just have to redo it, maybe add some small in-code images to make fancier menu.  A menu with some transparency and a shadow would be nice.  QB64 has some cool tools to utilize now days.

- Dav

[bplus]

@SMcNeill

I had a fun little mod for your code but I load and run it and nothing, but big black screen. I am using QB64 v1.4 stable, maybe your code was designed for something else?

I am sure I can find the glitch but if you could save me some trouble, I'd appreciate it.

Update: dah... never mind RMB means right mouse button ;-))

That's nice too AND it pops up where the mouse is so you aren't blocking something you might want to see while using menu and that is nice demo how one menu item can become a whole other menu. This is perfect for a Paint app the pop-up almost looks like a palette. (Hint to Ken maybe)

[SMcNeill]

@Dav: Richard posted code from the old [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] forums which might be what you were thinking of, where I modded your example a little:

Code: QB64: [Select]

1. DECLARE FUNCTION RightClickMenu% ()
2.  
3. DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
4. DIM SHARED RightClickList$(1 TO RightClickItems)
5.  
6. RightClickList$(1) = "New" '     <------------ List all your menu items here
7. RightClickList$(2) = "Open..."
8. RightClickList$(3) = "Save"
9. RightClickList$(4) = "Save As..."
10. RightClickList$(5) = "---" '     <------------ This means it's a separator (---)
11. RightClickList$(6) = "Settings..."
12. RightClickList$(7) = "About"
13. RightClickList$(8) = "---" '     <------------ (another separator)
14. RightClickList$(9) = "Exit"
15.  
16. '========================================================================================
17.  
18.  
19. '=== Demo follows....
20.  
21. SCREEN _NEWIMAGE(640, 480, 32)
22. font& = _LOADFONT("c:\windows\fonts\cour.ttf", 24, "MONOSPACE")
23. _FONT font&
24. PAINT (0, 0), _RGB(33, 66, 99)
25.  
26. '=== draw stuff
27. FOR x = 25 TO 610 STEP 3
28.     FOR y = 25 TO 300 STEP 3
29.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
30.     NEXT
31. NEXT
32.  
33. LOCATE (_HEIGHT - _FONTHEIGHT * 4) / _FONTHEIGHT, 1: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
34. PRINT "Right Click Anywhere for Popup menu.";
35. LOCATE (_HEIGHT - _FONTHEIGHT * 2) / _FONTHEIGHT, 1: PRINT "Select EXIT to quit.";
36.  
37. DO
38.  
39.     a% = RightClickMenu% ' <----- Check for rightclick menu
40.  
41.     '=== what did you select?
42.     IF a% > 0 THEN
43.         COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
44.         LOCATE (_HEIGHT - _FONTHEIGHT * 6) / _FONTHEIGHT, 1: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
45.     END IF
46.  
47. LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...
48.  
49. END
50.  
51.  
52.  
53. '================================================================================
54. '================================================================================
55. '================================================================================
56. FUNCTION RightClickMenu% ()
57.  
58.     'Returns 0 if nothing selected, else return number of item selected.
59.     'Requires RightClickList$ array defined.
60.  
61.     Cheese = _MOUSEINPUT
62.  
63.     IF _MOUSEBUTTON(2) THEN
64.  
65.         Row = FIX(_MOUSEY / _FONTHEIGHT): Col = FIX(_MOUSEX / _FONTWIDTH)
66.  
67.         x = Col * _FONTWIDTH - _FONTWIDTH: y = Row * _FONTHEIGHT - _FONTHEIGHT
68.  
69.         '=== Compute BoxWidth based on longest menu item string length
70.         BoxWidth = 0
71.         FOR t = 1 TO RightClickItems
72.             temp = LEN(RightClickList$(t)): IF temp > BoxWidth THEN BoxWidth = temp
73.         NEXT: BoxWidth = BoxWidth * _FONTWIDTH
74.  
75.         '=== Compute BoxHeight based on num of menu items
76.         BoxHeight = RightClickItems * _FONTHEIGHT
77.  
78.         '===== Make sure Mouse not too close to edge of screen
79.         '===== If it is, Adjust x & y position here, move in closer...
80.         IF _MOUSEX < 20 THEN
81.             Col = 3: x = Col * _FONTWIDTH - _FONTWIDTH:
82.         END IF
83.         IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
84.             xm = _WIDTH - (BoxWidth + 10)
85.             Col = FIX(xm / _FONTWIDTH): x = Col * _FONTWIDTH - _FONTWIDTH:
86.         END IF
87.         IF _MOUSEY < 20 THEN
88.             Row = 2: y = Row * _FONTHEIGHT - _FONTHEIGHT
89.         END IF
90.         IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
91.             xy = _HEIGHT - (BoxHeight + 10)
92.             Row = FIX(xy / _FONTHEIGHT): y = Row * _FONTHEIGHT - _FONTHEIGHT
93.         END IF
94.  
95.         FirstRow = Row - 1
96.  
97.         '=== copy screen using _mem (thanks Steve!)
98.         DIM m AS _MEM, n AS _MEM
99.         m = _MEMIMAGE(0)
100.         n = _MEMNEW(m.SIZE)
101.         _MEMCOPY m, m.OFFSET, m.SIZE TO n, n.OFFSET
102.  
103.         '=== trap until buttons up
104.         DO
105.             nibble = _MOUSEINPUT
106.         LOOP UNTIL NOT _MOUSEBUTTON(2)
107.  
108.         '=== Draw Box (10 pix padding)
109.         LINE (x - _FONTWIDTH, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
110.         LINE (x + _FONTWIDTH + BoxWidth, y - 10)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
111.         LINE (x - _FONTWIDTH, y + 10 + BoxHeight)-(x + _FONTWIDTH + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
112.         LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
113.         LINE (x - _FONTWIDTH + 1, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
114.         LINE (x + _FONTWIDTH - 1 + BoxWidth, y - 9)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
115.         LINE (x - _FONTWIDTH + 1, y + 9 + BoxHeight)-(x + _FONTWIDTH - 1 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
116.  
117.         DO
118.             Cheese = _MOUSEINPUT
119.  
120.             '=== if in bounds of menu space
121.             IF _MOUSEX > x AND _MOUSEX < x + BoxWidth AND _MOUSEY > y AND _MOUSEY < y + BoxHeight THEN
122.  
123.                 '=== Draw items
124.                 COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
125.                 IF FIX(_MOUSEY / _FONTHEIGHT) <> CurRow THEN
126.                     FOR t = 0 TO RightClickItems - 1
127.                         IF Row + t - FirstRow = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1 THEN
128.                             'Draw highlight box...
129.                             COLOR _RGB(255, 255, 255), _RGB(_FONTWIDTH, 36, 107)
130.                         ELSE
131.                             COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
132.                         END IF
133.                         padme = BoxWidth / _FONTWIDTH - LEN(RightClickList$(t + 1))
134.                         IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
135.                         LOCATE Row + t, Col - 1
136.                         IF RightClickList$(t + 1) = "---" THEN
137.                             COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
138.                             PRINT STRING$((BoxWidth / _FONTWIDTH) + 2, 196);
139.                         ELSE
140.                             PRINT " "; RightClickList$(t + 1); pad$; " ";
141.                         END IF
142.                     NEXT
143.                 END IF
144.  
145.                 IF _MOUSEBUTTON(1) THEN
146.                     sel = FIX(_MOUSEY / _FONTHEIGHT) - FirstRow + 1
147.                     'only select if not a seperator
148.                     IF RightClickList$(sel) <> "---" THEN
149.                         RightClickMenu% = sel: EXIT DO
150.                     END IF
151.                 END IF
152.  
153.                 IF _MOUSEBUTTON(2) THEN EXIT DO
154.  
155.             ELSE
156.                 'We went well off the click area.  Close the menu.
157.                 IF _MOUSEX < x - _FONTWIDTH OR _MOUSEX > x + BoxWidth + _FONTWIDTH THEN EXIT DO
158.                 IF _MOUSEY < y OR _MOUSEY > y + BoxHeight THEN EXIT DO
159.  
160.                 '=== Draw items
161.                 IF FIX(_MOUSEY / _FONTHEIGHT) <> CurRow THEN
162.                     FOR t = 0 TO RightClickItems - 1
163.                         IF RightClickList$(t + 1) = "---" THEN
164.                             COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
165.                             _PRINTSTRING (x, y + t * _FONTHEIGHT), STRING$((BoxWidth / _FONTWIDTH + 1), 196)
166.                         ELSE
167.                             COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
168.                             _PRINTSTRING (x, y + t * _FONTHEIGHT), RightClickList$(t + 1)
169.                         END IF
170.                     NEXT
171.                 END IF
172.  
173.                 IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO
174.  
175.             END IF
176.  
177.             '=== Mark the current row the mouse is in
178.  
179.             CurRow = FIX(_MOUSEY / _FONTHEIGHT)
180.  
181.         LOOP
182.  
183.         '=== restore screen
184.         _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
185.         _MEMFREE m: _MEMFREE n
186.  
187.     END IF
188.  
189. END FUNCTION
190. '================================================================================
191. '================================================================================
192. '================================================================================
193.  

There's several versions in the whole topic, but I just copied what seemed like the final one and shared it here, for ease of reference.  If you want to try the others out, or follow our old conversation where we altered and fixed things along the way to get to this point, the whole topic is now copied into my Popup Menu post in the Programs area.  (I'll come back and edit and link to it in a moment to save some searching, if anyone is curious...)

Edit: https://www.qb64.org/forum/index.php?topic=2773.msg120243#msg120243

[Dav]

Thanks, @SMcNeill  & @Richard.

Actually I've lost version 2 of mine which had multiple menu styles and user color schemes.  I dunno...maybe I'm confused and posted it at another QB64 forum...or planet...this is Earth isn't it? :)

Anyway, I appreciate your helpfulness.

- Dav

[Dav]

I just rediscovered the 2nd right click menu on an old HD that has different style menus.  Here it is finally...might as well keep it in this same thread with the other one above...

- Dav

Code: QB64: [Select]

1. '====================
2. 'RIGHT-CLICK-MENU.BAS
3. '====================
4. 'Easy to use right click popup menu.
5. 'Coded by Dav JULY/2013
6.  
7. 'Here's a single FUNCTION easy to add to your programs to have a right click popup menu.
8. 'Several menu styles to choose from - or set your own custom menu colors (See FUNCTION).
9. 'Menu lets you enable/disble items on the fly and you can also have menu separators.
10. 'Supports many screen sizes, never off screen, and restores original background on exit.
11. 'To use simply add the RightClickMenu% FUNCTION and its defines below to your program.
12. 'Study the demo code below to see how to call and use the function.
13.  
14. '========================================================================================
15. '================== DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT =======================
16. '========================================================================================
17.  
18. DECLARE FUNCTION RightClickMenu% (menustyle%) ' (not really needed, but it feels good)
19.  
20. DIM SHARED RightClickItems: RightClickItems = 9 '    <----- Number of items in your menu
21. DIM SHARED RightClickList$(1 TO RightClickItems) '          (change it to your number)
22.  
23. RightClickList$(1) = "New" '     <------------ List all your menu items here
24. RightClickList$(2) = "Open..."
25. RightClickList$(3) = "-Save" '   <------------ Leading minus makes these Disabled Items (-)
26. RightClickList$(4) = "-Save As..."
27. RightClickList$(5) = "---" '     <------------ This means it's a separator (---)
28. RightClickList$(6) = "Settings..."
29. RightClickList$(7) = "About"
30. RightClickList$(8) = "---" '     <------------ (another separator)
31. RightClickList$(9) = "Exit"
32.  
33. ' menustyle% values:      1 = Old Windows style
34. '                         2 = New Windows style
35. '                         3 = Dark grey Linux
36. '                         4 = Blue Glass (semi-transparent)
37. '                         5 = Custom colors (user defined)
38.  
39. '========================================================================================
40. 'NOTE: menustyle% #5 is for user defined colors.  You can set your own custom colors by
41. '      changing the menu variables inside the RightClickMenu% FUNCTION (look in there).
42. '      Then, call RighClickMenu(5) to use your custom colored menu style.
43. '========================================================================================
44.  
45.  
46. '========================================================================================
47. '=============================== START DEMO CODE ========================================
48. '========================================================================================
49.  
50. SCREEN _NEWIMAGE(640, 480, 32)
51.  
52. PAINT (0, 0), _RGB(33, 66, 99)
53.  
54. '=== draw stuff
55. FOR x = 25 TO 610 STEP 3
56.     FOR y = 25 TO 300 STEP 3
57.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
58.     NEXT
59. NEXT
60.  
61. LOCATE 23, 24: COLOR _RGB(255, 255, 255), _RGB(33, 66, 99)
62. PRINT "Right Click Anywhere for Popup menu."
63. LOCATE 25, 30: PRINT "Select EXIT to quit."
64.  
65. LOCATE 27, 24: PRINT "Press 3 to Enable/Disable: Save"
66. LOCATE 28, 24: PRINT "Press 4 to Enable/Disable: Save As..."
67.  
68. LOCATE 30, 10: PRINT "(keep making selections to cycle through different menu styles)";
69.  
70. style% = 5 'Start with menu style 5
71.  
72. DO
73.  
74.     a% = RightClickMenu%(style%) ' <----- Check for rightclick menu
75.  
76.     '=== what did you select?
77.     IF a% > 0 THEN
78.         COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
79.         LOCATE 21, 25: PRINT "You last selected: "; RightClickList$(a%); SPACE$(25);
80.         style% = style% + 1: IF style% = 6 THEN style% = 1 'cycle mnu styles
81.     END IF
82.  
83.     '===============================================================================
84.     'NOTE: You can re-enabled a disabled menu item by removing the leading minus '-'
85.     'from it's name.  And you can disable an item by adding a leading minus.
86.     '===============================================================================
87.  
88.     '=== Here we disable/enable items 3 & 4 on the fly by pressing 3 or 4.
89.  
90.     COLOR _RGB(255, 155, 55), _RGB(33, 66, 99)
91.     SELECT CASE INKEY$
92.         CASE IS = "3" ' Toggle Save menu on off
93.             LOCATE 27, 63
94.             IF RightClickList$(3) = "-Save" THEN
95.                 RightClickList$(3) = "Save": PRINT "ENABLED ";
96.             ELSE
97.                 RightClickList$(3) = "-Save": PRINT "DISABLED";
98.             END IF
99.         CASE IS = "4"
100.             LOCATE 28, 63
101.             IF RightClickList$(4) = "-Save As..." THEN
102.                 RightClickList$(4) = "Save As...": PRINT "ENABLED ";
103.             ELSE
104.                 RightClickList$(4) = "-Save As...": PRINT "DISABLED";
105.             END IF
106.     END SELECT
107.  
108. LOOP UNTIL a% = 9 'Item 9 (EXIT) exits demo...
109.  
110. END
111.  
112. '========================================================================================
113. '================================= END DEMO CODE ========================================
114. '========================================================================================
115.  
116.  
117. '========================================================================================
118. '==================================== FUNCTION ==========================================
119. '========================================================================================
120.  
121. FUNCTION RightClickMenu% (menustyle%)
122.     '
123.     'Creates a popup menu at the current mouse x/y position when right button is clicked.
124.     '
125.     'This function returns the value of the menu item seleted.  If no selection is made,
126.     'then the function will return a value of 0.  REQUIRES RightClickList$() array defined.
127.     '
128.     'menustyle% = Number of menu style to use. There are 5, and #5 is a custom color menu.
129.     '             You can set custom menu colors by changing the variables in this FUNCTION.
130.     '             (look lower down in this function to find those variables noted).
131.     '
132.     'SAMPLE USE:  ClickMe% = RightClickMenu%(3)  '<--- Use menu 3. If any selection is made,
133.     '                                                  the menu item selected is put into
134.     '                                                  the ClickMe% variable.
135.     '
136.     ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
137.  
138.     Cheese = _MOUSEINPUT ' Check for mouse activity.
139.  
140.     IF _MOUSEBUTTON(2) THEN ' If user clicked right button, draw menu....
141.  
142.         '============================================================================
143.         'Set Custom menu colors for menustyle% #5 here...
144.         '============================================================================
145.         RCMBorder~& = _RGB(255, 255, 255) '        <--- Border around menu
146.         RCMBack~& = _RGB(0, 0, 255) '              <--- Basic menu background color
147.         'menu item colors
148.         RCMEnText~& = _RGB(255, 255, 255) '        <--- Enabled menu item color
149.         RCMDisText~& = _RGB(190, 190, 190) '       <--- Disabled menu item color
150.         'below is the active row colors
151.         RCMHighBack~& = _RGB(255, 255, 255) '      <--- Highlight background color
152.         RCMHighEnText~& = _RGB(0, 0, 255) '        <--- Highlight Enabled Text color
153.         RCMHighDisText~& = _RGB(190, 190, 190) '   <----Highlight Disabled text color
154.         '============================================================================
155.  
156.         '=== fail safes values for failing memories
157.         IF menustyle% < 1 THEN menustyle% = 1
158.         IF menustyle% > 5 THEN menustyle% = 5
159.  
160.         'Compute Row & Col for LOCATE, and x & y for drawing
161.         Row = FIX(_MOUSEY / 16): Col = FIX(_MOUSEX / 8)
162.         x = Col * 8 - 8: y = Row * 16 - 16
163.  
164.         '=== Compute BoxWidth based on longest menu item string length
165.         BoxWidth = 0
166.         FOR t = 1 TO RightClickItems
167.             temp = LEN(RightClickList$(t))
168.             IF LEFT$(RightClickList$(t), 1) = "-" THEN temp = temp - 1
169.             IF temp > BoxWidth THEN BoxWidth = temp
170.         NEXT: BoxWidth = BoxWidth * 8
171.  
172.         '=== Compute BoxHeight based on num of menu items
173.         BoxHeight = RightClickItems * 16
174.  
175.         '===== Make sure Mouse not too close to edge of screen
176.         '===== If it is, Adjust position here, move in closer...
177.         IF _MOUSEX < 20 THEN
178.             Col = 3: x = Col * 8 - 8:
179.         END IF
180.         IF _MOUSEX + BoxWidth + 20 > _WIDTH THEN
181.             xm = _WIDTH - (BoxWidth + 10)
182.             Col = FIX(xm / 8): x = Col * 8 - 8:
183.         END IF
184.         IF _MOUSEY < 20 THEN
185.             Row = 2: y = Row * 16 - 16
186.         END IF
187.         IF _MOUSEY + BoxHeight + 20 > _HEIGHT THEN
188.             xy = _HEIGHT - (BoxHeight + 10)
189.             Row = FIX(xy / 16): y = Row * 16 - 16
190.         END IF
191.  
192.         FirstRow = Row - 1
193.  
194.         '=== copy screen using _mem (thanks Steve!)
195.         DIM m AS _MEM, n AS _MEM
196.         m = _MEMIMAGE(0)
197.         n = _MEMNEW(m.SIZE)
198.         _MEMCOPY m, m.OFFSET, m.SIZE TO n, n.OFFSET
199.  
200.         '=== trap until buttons up
201.         DO
202.             nibble = _MOUSEINPUT
203.         LOOP UNTIL NOT _MOUSEBUTTON(2)
204.  
205.         SELECT CASE menustyle%
206.             CASE 1: 'Classic menu
207.                 '=== Draw Box (10 pix padding)
208.                 LINE (x - 10, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(214, 211, 206), BF
209.                 LINE (x + 10 + BoxWidth, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
210.                 LINE (x - 10, y + 10 + BoxHeight)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(66, 65, 66), B
211.                 LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
212.                 LINE (x - 9, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(255, 255, 255), B
213.                 LINE (x + 9 + BoxWidth, y - 9)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
214.                 LINE (x - 9, y + 9 + BoxHeight)-(x + 9 + BoxWidth, y + 9 + BoxHeight), _RGB(127, 127, 127), B
215.             CASE 2: 'Win7 style
216.                 '=== Draw Box (10 pix padding)
217.                 LINE (x - 10, y - 10)-(x + 9 + BoxWidth, y + 10 + BoxHeight), _RGB(151, 151, 151), B
218.                 LINE (x - 9, y - 9)-(x + 8 + BoxWidth, y + 9 + BoxHeight), _RGB(245, 245, 245), B
219.                 LINE (x - 8, y - 8)-(x + 7 + BoxWidth, y + 8 + BoxHeight), _RGB(241, 241, 241), BF
220.             CASE 3: 'Dark Grey Linux style
221.                 '=== Draw Box (10 pix padding)
222.                 LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGB(85, 85, 85), BF
223.                 LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), _RGB(55, 55, 55), BF
224.             CASE 4: 'Transparent style
225.                 '=== Draw Box (10 pix padding)
226.                 LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), _RGBA32(0, 0, 0, 150), BF
227.                 LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), _RGBA32(100, 200, 255, 100), BF
228.                 '=== save original printmode
229.                 printmodestatus = _PRINTMODE
230.                 _PRINTMODE _KEEPBACKGROUND
231.             CASE 5 'custom colors
232.                 LINE (x - 11, y - 10)-(x + 10 + BoxWidth, y + 10 + BoxHeight), RCMBorder~&, BF
233.                 LINE (x - 9, y - 8)-(x + 8 + BoxWidth, y + 8 + BoxHeight), RCMBack~&, BF
234.         END SELECT
235.  
236.         'draw right drop shadow edge
237.         LINE (x + 11 + BoxWidth, y - 4)-(x + 11 + BoxWidth, y + 11 + BoxHeight), _RGBA32(0, 0, 0, 90), B
238.         LINE (x + 12 + BoxWidth, y - 3)-(x + 12 + BoxWidth, y + 12 + BoxHeight), _RGBA32(0, 0, 0, 60), B
239.         LINE (x + 13 + BoxWidth, y - 2)-(x + 13 + BoxWidth, y + 13 + BoxHeight), _RGBA32(0, 0, 0, 40), B
240.         LINE (x + 14 + BoxWidth, y - 1)-(x + 14 + BoxWidth, y + 14 + BoxHeight), _RGBA32(0, 0, 0, 25), B
241.         LINE (x + 15 + BoxWidth, y)-(x + 15 + BoxWidth, y + 15 + BoxHeight), _RGBA32(0, 0, 0, 10), B
242.  
243.         'draw bottom drop shadow edge
244.         LINE (x - 4, y + 11 + BoxHeight)-(x + 10 + BoxWidth, y + 11 + BoxHeight), _RGBA32(0, 0, 0, 90), B
245.         LINE (x - 3, y + 12 + BoxHeight)-(x + 11 + BoxWidth, y + 12 + BoxHeight), _RGBA32(0, 0, 0, 60), B
246.         LINE (x - 2, y + 13 + BoxHeight)-(x + 12 + BoxWidth, y + 13 + BoxHeight), _RGBA32(0, 0, 0, 40), B
247.         LINE (x - 1, y + 14 + BoxHeight)-(x + 13 + BoxWidth, y + 14 + BoxHeight), _RGBA32(0, 0, 0, 25), B
248.         LINE (x, y + 15 + BoxHeight)-(x + 14 + BoxWidth, y + 15 + BoxHeight), _RGBA32(0, 0, 0, 10), B
249.  
250.  
251.         DO
252.             Cheese = _MOUSEINPUT
253.  
254.             '=== if in bounds of menu space
255.             IF _MOUSEX > x AND _MOUSEX < x + BoxWidth AND _MOUSEY > y AND _MOUSEY < y + BoxHeight THEN
256.  
257.                 '=== Draw items
258.                 IF CurRow <> FIX(_MOUSEY / 16) THEN
259.                     FOR t = 0 TO RightClickItems - 1
260.                         IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
261.                             'If highlighted row, draw highlight colors...
262.                             SELECT CASE menustyle%
263.                                 CASE 1: COLOR _RGB(255, 255, 255), _RGB(8, 36, 107) 'classic
264.                                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(8, 36, 107)
265.                                 CASE 2: COLOR _RGB(0, 0, 0), _RGB(215, 225, 235) 'win7
266.                                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(215, 225, 235)
267.                                 CASE 3: COLOR _RGB(50, 50, 50), _RGB(180, 180, 180) 'dark grey linux
268.                                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127), _RGB(180, 180, 180)
269.                                 CASE 4: COLOR _RGB(130, 255, 255) 'transparent
270.                                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR _RGB(127, 127, 127)
271.                                 CASE 5
272.                                     COLOR RCMHighEnText~&, RCMHighBack~& 'custom
273.                                     IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN COLOR RCMHighDisText~&, RCMHighBack~&
274.  
275.                             END SELECT
276.                         ELSE
277.                             IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
278.                                 SELECT CASE menustyle%
279.                                     CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
280.                                     CASE 2: COLOR _RGB(127, 127, 127), _RGB(240, 240, 240) 'win7
281.                                     CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
282.                                     CASE 4: COLOR _RGB(127, 127, 127)
283.                                     CASE 5: COLOR RCMDisText~&, RCMBack~&
284.                                 END SELECT
285.                             ELSE
286.                                 SELECT CASE menustyle%
287.                                     CASE 1: COLOR _RGB(0, 0, 0), _RGB(214, 211, 206)
288.                                     CASE 2: COLOR _RGB(0, 0, 0), _RGB(240, 240, 240)
289.                                     CASE 3: COLOR _RGB(213, 209, 199), _RGB(55, 55, 55)
290.                                     CASE 4: COLOR _RGB(200, 200, 200)
291.                                     CASE 5: COLOR RCMEnText~&, RCMBack~&
292.                                 END SELECT
293.                             END IF
294.                         END IF
295.                         padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
296.                         IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme + 1
297.                         IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
298.                         LOCATE Row + t, Col - 1
299.                         IF RightClickList$(t + 1) = "---" THEN
300.                             SELECT CASE menustyle%
301.                                 CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206)
302.                                 CASE 2: COLOR _RGB(208, 208, 208), _RGB(240, 240, 240)
303.                                 CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55)
304.                                 CASE 4: COLOR _RGB(0, 0, 0)
305.                                 CASE 5: COLOR RCMDisText~&, RCMBack~&
306.                             END SELECT
307.                             PRINT STRING$((BoxWidth / 8) + 2, 196);
308.                         ELSE
309.                             IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
310.                                 PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
311.                             ELSE
312.                                 PRINT " "; RightClickList$(t + 1); pad$; " ";
313.                             END IF
314.                             SELECT CASE menustyle%
315.                                 CASE 2: 'win7 box around highlight area
316.                                     '=== Draw box around highlighted
317.                                     IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
318.                                         BoxRow = FIX(_MOUSEY / 16): by = BoxRow * 16 - 16
319.                                         LINE (x - 8, by + 16)-(x + BoxWidth + 7, by + 31), _RGB(174, 207, 247), B
320.                                     END IF
321.                                 CASE 3: 'dark grey
322.                                     '=== Draw box around highlighted
323.                                     IF Row + t - FirstRow = FIX(_MOUSEY / 16) - FirstRow + 1 THEN
324.                                         BoxRow = FIX(_MOUSEY / 16): by = BoxRow * 16 - 16
325.                                         LINE (x - 8, by + 16)-(x + BoxWidth + 7, by + 31), _RGB(240, 240, 240), B
326.                                     END IF
327.                             END SELECT
328.                         END IF
329.                     NEXT
330.                 END IF
331.  
332.                 '=== left click makes a selection
333.                 IF _MOUSEBUTTON(1) THEN
334.                     sel = FIX(_MOUSEY / 16) - FirstRow + 1
335.                     'only select if not a seperator and not disabled
336.                     IF RightClickList$(sel) <> "---" THEN
337.                         IF LEFT$(RightClickList$(sel), 1) <> "-" THEN
338.                             RightClickMenu% = sel: EXIT DO
339.                         END IF
340.                     END IF
341.                 END IF
342.  
343.                 '=== right click closes menu
344.                 IF _MOUSEBUTTON(2) THEN EXIT DO
345.  
346.             ELSE
347.  
348.                 '=== Draw items
349.                 IF FIX(_MOUSEY / 16) <> CurRow THEN
350.                     FOR t = 0 TO RightClickItems - 1
351.                         padme = BoxWidth / 8 - LEN(RightClickList$(t + 1))
352.                         IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN padme = padme + 1
353.                         IF padme > 0 THEN pad$ = SPACE$(padme) ELSE pad$ = ""
354.                         LOCATE Row + t, Col - 1
355.                         IF RightClickList$(t + 1) = "---" THEN
356.                             SELECT CASE menustyle%
357.                                 CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
358.                                 CASE 2: COLOR _RGB(208, 208, 208), _RGB(240, 240, 240) 'win7
359.                                 CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
360.                                 CASE 4: COLOR _RGB(0, 0, 0)
361.                                 CASE 5: COLOR RCMDisText~&, RCMBack~&
362.                             END SELECT
363.                             PRINT STRING$((BoxWidth / 8) + 2, 196);
364.                         ELSE
365.  
366.                             IF LEFT$(RightClickList$(t + 1), 1) = "-" THEN
367.                                 SELECT CASE menustyle%
368.                                     CASE 1: COLOR _RGB(127, 127, 127), _RGB(214, 211, 206) 'classic
369.                                     CASE 2: COLOR _RGB(127, 127, 127), _RGB(240, 240, 240) 'win7
370.                                     CASE 3: COLOR _RGB(127, 127, 127), _RGB(55, 55, 55) 'dark grey
371.                                     CASE 4: COLOR _RGB(127, 127, 127)
372.                                     CASE 5: COLOR RCMDisText~&, RCMBack~&
373.                                 END SELECT
374.                                 PRINT " "; RIGHT$(RightClickList$(t + 1), LEN(RightClickList$(t + 1)) - 1); pad$; " ";
375.                             ELSE
376.                                 SELECT CASE menustyle%
377.                                     CASE 1: COLOR _RGB(0, 0, 0), _RGB(214, 211, 206) 'classic
378.                                     CASE 2: COLOR _RGB(0, 0, 0), _RGB(240, 240, 240) 'win7
379.                                     CASE 3: COLOR _RGB(213, 209, 199), _RGB(55, 55, 55) 'dark grey
380.                                     CASE 4: COLOR _RGB(200, 200, 200)
381.                                     CASE 5: COLOR RCMEnText~&, RCMBack~&
382.                                 END SELECT
383.                                 PRINT " "; RightClickList$(t + 1); pad$; " ";
384.                             END IF
385.  
386.                         END IF
387.                     NEXT
388.                 END IF
389.  
390.                 IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN EXIT DO
391.  
392.             END IF
393.  
394.             '=== Mark current row mouse is in
395.             CurRow = FIX(_MOUSEY / 16)
396.  
397.         LOOP
398.  
399.         '=== restore screen
400.         _MEMCOPY n, n.OFFSET, n.SIZE TO m, m.OFFSET
401.         _MEMFREE m: _MEMFREE n
402.  
403.         '=== restore original printmode
404.         IF menustyle% = 4 THEN
405.             SELECT CASE printmodestatus
406.                 CASE 1: _PRINTMODE _KEEPBACKGROUND
407.                 CASE 2: _PRINTMODE _ONLYBACKGROUND
408.                 CASE 3: _PRINTMODE _FILLBACKGROUND
409.             END SELECT
410.         END IF
411.  
412.     END IF
413.  
414. END FUNCTION
415. '================================================================================
416. '================================================================================
417.