« previous next »
Pages: 1 [2]   Go Down

Author Topic: File Menu  (Read 5317 times)

0 Members and 1 Guest are viewing this topic.

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: File Menu
« Reply #15 on: June 30, 2020, 10:49:37 pm »
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
  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.  
  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.  
  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.  
  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
  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.  
  217.  
  219. '================================================================================
  220. '================================================================================
  221. '================================================================================
  222.  
« Last Edit: June 30, 2020, 10:50:43 pm by Dav »
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: File Menu
« Reply #16 on: June 30, 2020, 11:21:23 pm »
Oh that's nice @Dav

I'm akeep'n that one!
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: File Menu
« Reply #17 on: July 01, 2020, 12:31:25 am »
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.
Logged

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: File Menu
« Reply #18 on: July 01, 2020, 01:16:04 am »
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
  4.  
  6.  
  8.     DO
  9.         MScroll = MScroll + _MOUSEWHEEL
  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
  41.  
  42. FUNCTION DrawMenu% (Menu AS _BYTE, x AS INTEGER, y AS INTEGER)
  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.  
  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
  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.  
  192.  

« Last Edit: July 01, 2020, 01:18:42 am by SMcNeill »
Logged
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: File Menu
« Reply #19 on: July 01, 2020, 07:45:19 am »
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
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: File Menu
« Reply #20 on: July 01, 2020, 11:26:45 am »
@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)
« Last Edit: July 01, 2020, 11:54:57 am by bplus »
Logged

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: File Menu
« Reply #21 on: July 03, 2020, 01:01:13 pm »
@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
  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.  
  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.  
  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.  
  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.  
  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
« Last Edit: July 03, 2020, 01:02:20 pm by SMcNeill »
Logged
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: File Menu
« Reply #22 on: July 03, 2020, 05:41:01 pm »
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

Logged

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: File Menu
« Reply #23 on: July 30, 2020, 09:27:35 pm »
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
  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.  
  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)
  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.  
  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.  
  415. '================================================================================
  416. '================================================================================
  417.  
Logged
Pages: 1 [2]   Go Up
« previous next »