QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Pete on October 06, 2021, 06:22:00 pm

Title: Mighty Menu?
Post by: Pete on October 06, 2021, 06:22:00 pm

I bet Steve is getting mighty tired of these menu titles, but since we are on the subject of menus...

Code: QB64: [Select]

1. REM mydemo% = -1
2. DIM UI AS UserInput
3. REDIM Menu$(100)
4.  
5. TYPE UserInput
6.     KeyPress AS STRING
7.     KeyCombos AS INTEGER
8.     MbStatus AS INTEGER
9.     MbEnvoked AS INTEGER
10.     drag AS INTEGER
11.     DoubleClick AS INTEGER
12.     MbLeftx AS INTEGER
13.     MbLefty AS INTEGER
14.     mx AS INTEGER
15.     oldmx AS INTEGER
16.     my AS INTEGER
17.     oldmy AS INTEGER
18. END TYPE
19.  
20. IF demo% THEN PRINT "Press keys or use mouse for demo.";
21. DO
22.     MenuSetup = MenuSetup + 1: GOSUB MenuSetup
23.     DO
24.         CALL keyboard_mouse(UI, mydemo%)
25.         IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
26.             SOUND 1000, .1
27.             UI.MbEnvoked = -1
28.         END IF
29.  
30.         SELECT CASE UI.MbStatus
31.             CASE -1
32.                 GOSUB FindMenu
33.  
34.                 SELECT CASE x$
35.                     CASE Menu$(1)
36.                         LOCATE 1, 1: PRINT Menu$(1); "                  ";
37.                         _DELAY 2
38.                         EXIT DO
39.                     CASE Menu$(2)
40.                         LOCATE 1, 1: PRINT Menu$(2); "                  ";
41.                     CASE Menu$(3)
42.                         LOCATE 1, 1: PRINT Menu$(3); "                  ";
43.                     CASE Menu$(4)
44.                         LOCATE 1, 1: PRINT Menu$(4); "                  ";
45.                     CASE Menu$(5)
46.                         END
47.                 END SELECT
48.  
49.         END SELECT
50.     LOOP
51. LOOP UNTIL MenuSetup = 2
52. END
53.  
54. MenuSetup:
55. SELECT CASE MenuSetup
56.     CASE 1
57.         MenuType% = 1
58.         DrawBox% = -1
59.         MenuX = 0 ' Auto-Center
60.         MenuY = 0 ' Auto-Center
61.         Menu$(1) = "[Enter] Next Menu"
62.         Menu$(2) = "[F1] Help"
63.         Menu$(3) = "[F5] Save"
64.         Menu$(4) = "[F12] Run Demo"
65.         Menu$(5) = "[Esc] End"
66.         Menu$(6) = ""
67.         Menu$(7) = ""
68.         Menu$(8) = ""
69.         Menu$(9) = ""
70.         Menu$(10) = ""
71.     CASE 2
72.         MenuType% = 2
73.         DrawBox% = 0
74.         MenuX = 0 ' Auto-Center
75.         MenuY = 0 ' Auto-Center
76.         Menu$(1) = "[Enter] Next Menu"
77.         Menu$(2) = "[F1] Help"
78.         Menu$(3) = "[F5] Save"
79.         Menu$(4) = "[F12] Run Demo"
80.         Menu$(5) = "[Esc] End"
81.         Menu$(6) = ""
82.         Menu$(7) = ""
83.         Menu$(8) = ""
84.         Menu$(9) = ""
85.         Menu$(10) = ""
86. END SELECT
87.  
88. FOR noe = UBOUND(Menu$) TO 1 STEP -1
89.     IF LEN(Menu$(noe)) THEN EXIT FOR
90. NEXT
91.  
92. SELECT CASE MenuType%
93.     CASE 1
94.         x = 0
95.         FOR i = 1 TO noe
96.             IF LEN(Menu$(i)) > x THEN x = LEN(Menu$(i))
97.         NEXT
98.  
99.         IF MenuX = 0 THEN MenuX = INT(_WIDTH / 2 + 1 - (x / 2))
100.         IF MenuY = 0 THEN MenuY = INT(_HEIGHT / 2 - (noe / 2) - 1)
101.  
102.         IF DrawBox% THEN GOSUB DrawBox
103.  
104.         FOR i = 1 TO noe
105.             LOCATE MenuY + i - 1, MenuX
106.             PRINT Menu$(i);
107.         NEXT
108.     CASE 2
109.         Menu$ = "": x$ = "": k = 0
110.         FOR i = 1 TO noe
111.             IF LEN(Menu$(i)) THEN
112.                 k = k + 1: Menu$ = Menu$ + CHR$(255) + Menu$(i)
113.             END IF
114.         NEXT
115.         j = (_WIDTH - LEN(Menu$)) \ k
116.         IF j > 5 THEN j = 5
117.         Menu$ = MID$(Menu$, 2) + CHR$(255)
118.         DO UNTIL INSTR(Menu$, CHR$(255)) = 0
119.             a$ = CHR$(255) + MID$(Menu$, 1, INSTR(Menu$, CHR$(255)) - 1) 'SPACE$(j)
120.             Menu$ = MID$(Menu$, INSTR(Menu$, CHR$(255)) + 1)
121.             x$ = x$ + a$ + SPACE$(j)
122.         LOOP
123.         Menu$ = _TRIM$(x$)
124.         CLS
125.         LOCATE _HEIGHT, _WIDTH \ 2 - LEN(Menu$) \ 2
126.         PRINT Menu$;
127. END SELECT
128. RETURN
129.  
130. DrawBox:
131. LOCATE MenuY - 1, MenuX - 2
132. PRINT CHR$(218) + STRING$(x + 2, 196) + CHR$(191)
133. FOR i = 1 TO noe
134.     LOCATE , MenuX - 2
135.     PRINT CHR$(179);: LOCATE , POS(0) + x + 2: PRINT CHR$(179)
136. NEXT
137. LOCATE , MenuX - 2
138. PRINT CHR$(192) + STRING$(x + 2, 196) + CHR$(217);
139. RETURN
140.  
141. FindMenu:
142. SELECT CASE MenuType%
143.     CASE 0
144.         CLS: PRINT "You did not assign a value to the variable: MenuType": END '''
145.     CASE 1 ' Vertical
146.         IF UI.my >= MenuY AND UI.my <= MenuY + noe - 1 THEN
147.             x$ = ""
148.             FOR i = MenuX TO MenuX + x
149.                 a$ = CHR$(SCREEN(UI.my, i))
150.                 x$ = x$ + a$
151.                 IF flag = 0 THEN IF a$ <> " " THEN flag = i
152.             NEXT
153.             x$ = _TRIM$(x$)
154.             IF UI.mx >= flag AND UI.mx <= flag + LEN(x$) THEN
155.                 IF VAL(x$) THEN x$ = LTRIM$(STR$(VAL(x$)))
156.             END IF
157.             flag = 0
158.         END IF
159.     CASE 2 ' Horizontal
160.         x$ = ""
161.         FOR i = 1 TO _WIDTH
162.             a$ = CHR$(SCREEN(UI.my, i))
163.             x$ = x$ + a$
164.         NEXT
165.         x$ = CHR$(255) + x$ + CHR$(255)
166.         x$ = _TRIM$(MID$(x$, 1, INSTR(UI.mx + 1, x$, CHR$(255)) - 1))
167.         IF LEN(x$) <= UI.mx THEN
168.             x$ = "" ' Mouse is not on a menu item.
169.         ELSE
170.             x$ = _TRIM$(MID$(x$, _INSTRREV(x$, CHR$(255)) + 1))
171.         END IF
172.     CASE ELSE
173.         CLS: PRINT "You assigned a value to MenuType that was out-of-range.": END '''
174. END SELECT
175. RETURN
176.  
177. SUB keyboard_mouse (UI AS UserInput, mydemo%)
178.     STATIC z1, lclick
179.  
180.     _LIMIT 30
181.  
182.     DEF SEG = 0
183.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
184.         UI.KeyCombos = 1 ' Shift  % = -1 ELSE shift% = 0
185.     ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
186.         UI.KeyCombos = 2 ' Ctrl  % = -1 ELSE ctrl% = 0
187.     ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
188.         UI.KeyCombos = 3 ' Alt  % = -1
189.     ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
190.         UI.KeyCombos = 4 ' Ctrl+Shift  % = -1 ELSE ctrlshift% = 0
191.     ELSE
192.         UI.KeyCombos = 0
193.     END IF
194.     DEF SEG
195.  
196.     IF mydemo% THEN GOSUB check_UI.KeyCombos
197.  
198.     UI.KeyPress = INKEY$
199.     IF LEN(UI.KeyPress) THEN ' A key was pressed.
200.         UI.MbEnvoked = 0: UI.MbLeftx = 0
201.         SELECT CASE LEN(UI.KeyPress)
202.             CASE 1 ' 1-byte key A-Z, etc.
203.                 IF mydemo% THEN mydemo% = 1: GOSUB mydemo
204.                 SELECT CASE UI.KeyPress
205.                     ' Place key selection routine here...
206.                     CASE CHR$(27): SYSTEM
207.                 END SELECT
208.             CASE 2 '2-byte key F1-F12, etc.
209.                 IF mydemo% THEN mydemo% = 2: GOSUB mydemo
210.                 SELECT CASE RIGHT$(UI.KeyPress, 1)
211.                     ' Place key selection routine here...
212.                 END SELECT
213.         END SELECT
214.     ELSE ' Check for mouse input since no keyboard input was detected.
215.  
216.         IF lclick THEN ' Check timer for double-clicks.
217.             IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
218.             IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
219.         END IF
220.  
221.         WHILE _MOUSEINPUT
222.             mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
223.         WEND
224.  
225.         ' Get mouse status.
226.         UI.mx = _MOUSEX
227.         UI.my = _MOUSEY
228.         lb = _MOUSEBUTTON(1)
229.         rb = _MOUSEBUTTON(2)
230.         mb = _MOUSEBUTTON(3)
231.  
232.         SELECT CASE UI.MbEnvoked
233.             CASE 0
234.                 IF lb OR rb OR mb THEN
235.  
236.                 END IF
237.             CASE 1
238.                 IF lb OR rb OR mb THEN UI.MbEnvoked = 0
239.             CASE -1
240.                 IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
241.         END SELECT
242.  
243.         IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
244.             SELECT CASE UI.MbStatus
245.                 CASE -1 ' Left button was pressed.
246.                     IF lb = 0 THEN ' Left button released.
247.                         SELECT CASE lclick ' Single or double click analysis.
248.                             CASE 0
249.                                 IF mydemo% THEN mydemo% = 3: GOSUB mydemo
250.                                 lclick = lclick + 1
251.                             CASE ELSE ' Double click. Completed upon 2nd left button release.
252.                                 IF mydemo% THEN mydemo% = 11: GOSUB mydemo
253.                                 UI.DoubleClick = -1
254.                                 lclick = 0
255.                         END SELECT
256.                         UI.MbStatus = 1
257.  
258.                         IF UI.MbLeftx THEN
259.                             IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
260.                             UI.MbLeftx = 0: UI.MbLefty = 0
261.                         END IF
262.  
263.                         IF UI.drag THEN UI.drag = 0
264.                     ELSE ' Left button is being held down. Check for UI.drag.
265.                         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
266.                             IF mydemo% THEN mydemo% = 12: GOSUB mydemo
267.                             UI.drag = -1
268.                         END IF
269.                     END IF
270.                 CASE -2 ' Right button was pressed.
271.                     IF rb = 0 THEN ' Right button was relased.
272.                         IF mydemo% THEN mydemo% = 4: GOSUB mydemo
273.                         UI.MbStatus = 2
274.                     END IF
275.                 CASE -3 ' Middle button was pressed
276.                     IF mb = 0 THEN ' Middle button was released.
277.                         IF mydemo% THEN mydemo% = 5: GOSUB mydemo
278.                         UI.MbStatus = 3
279.                     END IF
280.             END SELECT
281.         ELSE
282.             IF lb THEN ' Left button just pressed.
283.                 IF mydemo% THEN mydemo% = 6: GOSUB mydemo
284.                 UI.MbStatus = -1
285.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
286.                 z1 = TIMER
287.             ELSEIF rb THEN ' Right button just pressed.
288.                 IF mydemo% THEN mydemo% = 7: GOSUB mydemo
289.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
290.                 UI.MbStatus = -2
291.             ELSEIF mb THEN ' Middle button just pressed.
292.                 IF mydemo% THEN mydemo% = 8: GOSUB mydemo
293.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
294.                 UI.MbStatus = -3
295.             ELSEIF mw THEN ' Mouse wheel just moved.
296.                 SELECT CASE mw
297.                     CASE IS > 0 ' Scroll down.
298.                         IF mydemo% THEN mydemo% = 9: GOSUB mydemo
299.                     CASE IS < 0 ' Scroll up.
300.                         IF mydemo% THEN mydemo% = 10: GOSUB mydemo
301.                 END SELECT
302.             END IF
303.         END IF
304.  
305.         UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
306.     END IF
307.     EXIT SUB
308.  
309.     mydemo:
310.     LOCATE 1, 1: PRINT "Last User Status:                                    ";
311.     LOCATE , 19
312.     SELECT CASE mydemo%
313.         CASE 1
314.             PRINT "1-byte Key = "; UI.KeyPress
315.         CASE 2
316.             PRINT "2-byte Key = "; UI.KeyPress
317.         CASE 3
318.             PRINT "Left button released."
319.         CASE 4
320.             PRINT "Right button released."
321.         CASE 5
322.             PRINT "Middle button released."
323.         CASE 6
324.             PRINT "Left button down."
325.         CASE 7
326.             PRINT "Right button down."
327.         CASE 8
328.             PRINT "Middle button down."
329.         CASE 9
330.             PRINT "Wheel scroll down."
331.         CASE 10
332.             PRINT "Wheel scroll up."
333.         CASE 11
334.             PRINT "Left button double click."
335.         CASE 12
336.             PRINT "Drag..."
337.     END SELECT
338.     mydemo% = -1
339.     RETURN
340.  
341.     check_UI.KeyCombos:
342.     IF UI.KeyCombos THEN
343.         LOCATE 1, 50
344.         SELECT CASE UI.KeyCombos
345.             CASE 1
346.                 PRINT "Shift key down.        ";
347.             CASE 2
348.                 PRINT "Ctrl key down.         ";
349.             CASE 3
350.                 PRINT "Alt key down.          ";
351.             CASE 4
352.                 PRINT "Ctrl + Shift key down. ";
353.         END SELECT
354.     ELSE
355.         LOCATE 1, 50: PRINT SPACE$(29);
356.     END IF
357.     RETURN
358. END SUB

So in time, I will reinvent one of my many wheels again, and much like the mouse routine, that this routine uses, I will have a universal menu routine. The next stage is to put the horizontal menu in. Ah, did I mention how much I love that edit post feature restored? I think I did.

So if this goes well, all that would be needed is for the user to decide on a couple of options, like the box around the vertical menu, and then just fill in as many of the menu$() arrays. Skip every-other one to space the entries. Of course, it will get more complicated. Scrolling menu for more than the height of the program window will allow, etc.

Anyway, I'd just thought I'd post what I have so far. I wish I was more comfortable with _PRINTSTRING. It would be fun to be working on a graphics clone.
 
Pete

EDIT: Added the horizontal menu option.

Text Only | Text with Attachments