Custom Menu [Windows]

Share your advanced PureBasic knowledge/code with the community.
Post Reply
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4941
Joined: Sun Apr 12, 2009 6:27 am

Custom Menu [Windows]

Post by RASHAD »

Hi all
Just to refresh my mind :)
The title say it all
DPI aware

Code: Select all

Global dpix.d,dpiy.d,itemy

dpix = DesktopResolutionX()
dpiy = DesktopResolutionY()

UsePNGImageDecoder()

Procedure IsMouseOver(hWnd) 
  GetWindowRect_(hWnd,r.RECT) 
  GetCursorPos_(p.POINT) 
  Result = PtInRect_(r,p\y << 32 + p\x) 
  ProcedureReturn Result 
EndProcedure 

Procedure winCB(hWnd,uMsg,wParam,lParam)
  Select uMsg
    Case #WM_ENTERIDLE
      GetCursorPos_(cpt.POINT)
      hHnd = WindowFromPoint_(cpt\y<<32 + cpt\x)   
      If hHnd = hwnd Or hHnd = GadgetID(0)
        SendMessage_(hwnd, #WM_CANCELMODE,0,0)
      EndIf
      
    Case #WM_SIZE,#WM_MOVE
      ResizeGadget(0,0,0,WindowWidth(0),GadgetHeight(0))
      ResizeGadget(10,GadgetWidth(0)-58, 4, 54, itemy)
  EndSelect
  
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

OpenWindow(0, 0, 0, 600, 400, "Custom Menu", #PB_Window_SystemMenu | #PB_Window_SizeGadget |#PB_Window_ScreenCentered)
WindowBounds(0,300,200,#PB_Default,#PB_Default)
ContainerGadget(0,0,0,600,36,#PB_Container_Flat)
itemy = GadgetHeight(0)-6
SetGadgetColor(0,#PB_Gadget_BackColor,0)
TextGadget(1, 2, 2, 34, itemy,"File",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(1,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(1,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(2, 42, 2, 60, itemy,"Image",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(2,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(2,#PB_Gadget_FrontColor,$FFFFFF)    
TextGadget(10, GadgetWidth(0)-58, 2, 54, itemy,"Help",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(10,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(10,#PB_Gadget_FrontColor,$FFFFFF)
CloseGadgetList()

CreatePopupImageMenu(0)      
MenuItem( 1, "New",LoadImage(10, #PB_Compiler_Home + "examples/sources/Data/ToolBar/New.png")) 
MenuItem( 2, "Open",LoadImage(11, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Open.png"))
MenuItem( 3, "Save",LoadImage(12, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png"))
MenuBar()
OpenSubMenu("Recents")
MenuItem( 5, "Pure.png")
MenuItem( 6, "Basic.jpg")
OpenSubMenu("Even more !")
MenuItem( 12, "Yeah")
CloseSubMenu()
MenuItem( 13, "Rocks.tga")
CloseSubMenu()
MenuBar()
MenuItem( 7, "&Quit")

CreatePopupImageMenu(1)
MenuItem( 8, "Cut",LoadImage(13, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Cut.png"))
MenuItem( 9, "Copy",LoadImage(14, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Copy.png"))
MenuItem(10, "Paste",LoadImage(15, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Paste.png"))

CreatePopupImageMenu(10)
MenuItem(11, "Contents and Index",LoadImage(16, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Find.png"))
MenuItem(12, "About")

SetWindowCallback(@winCB())

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case EventMenu()
          Debug EventMenu()          
          downflag = 0
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          DisplayPopupMenu(0, WindowID(0), GadgetX(1,#PB_Gadget_ScreenCoordinate )*dpix,yy)
          downflag = 1
        Case 2
          DisplayPopupMenu(1, WindowID(0), GadgetX(2,#PB_Gadget_ScreenCoordinate )*dpix,yy)
          downflag = 1
        Case 10
          DisplayPopupMenu(10, WindowID(0), GadgetX(10,#PB_Gadget_ScreenCoordinate )*dpix-200*dpix,yy)
          downflag = 1
      EndSelect    
      
    Case #WM_MOUSEMOVE
      yy = (GadgetY(0,#PB_Gadget_ScreenCoordinate )+GadgetHeight(0)-3)*dpiy
      If downflag = 1
        If IsMouseOver(GadgetID(1))
          DisplayPopupMenu(0, WindowID(0), GadgetX(1,#PB_Gadget_ScreenCoordinate )*dpix,yy)
        ElseIf IsMouseOver(GadgetID(2))
          DisplayPopupMenu(1, WindowID(0), GadgetX(2,#PB_Gadget_ScreenCoordinate )*dpix,yy)
        ElseIf IsMouseOver(GadgetID(10))
          DisplayPopupMenu(10, WindowID(0), GadgetX(10,#PB_Gadget_ScreenCoordinate )*dpix-200*dpix,yy)
        EndIf
      EndIf
  EndSelect 
Until Quit = 1
Edit :Code modified
Edit 2 :Modified
Edit 3 :Modified
Last edited by RASHAD on Tue Jul 22, 2025 10:12 am, edited 4 times in total.
Egypt my love
Top
Little John
Addict
Addict
Posts: 4770
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Custom Menu [Windows]

Post by Little John »

Looks good. :thumbsup: Thanks for sharing! :-)
Top
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: Custom Menu [Windows]

Post by Bisonte »

looks good, but if the y value of the popupmenu is too far away from the gadget, there is no chance to use it ;)

You made it 45 but the gadget is only 30 in height... so the menu dissappears if you try to reach it ...
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 456
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Custom Menu [Windows]

Post by Mindphazer »

Bisonte wrote: Mon Jul 21, 2025 7:57 am looks good, but if the y value of the popupmenu is too far away from the gadget, there is no chance to use it ;)

You made it 45 but the gadget is only 30 in height... so the menu dissappears if you try to reach it ...
Indeed... :mrgreen:
replace each dpiy+45 by dpiy+30, and it works much better
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 15.4.1 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4941
Joined: Sun Apr 12, 2009 6:27 am

Re: Custom Menu [Windows]

Post by RASHAD »

Thanks guys :)
Previous post updated
Egypt my love
Top
User avatar
minimy
Enthusiast
Enthusiast
Posts: 551
Joined: Mon Jul 08, 2013 8:43 pm
Location: off world

Re: Custom Menu [Windows]

Post by minimy »

Nice example RASHAD, as allways.
Thanks for share!
If translation=Error: reply="Sorry, Im Spanish": Endif
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4941
Joined: Sun Apr 12, 2009 6:27 am

Re: Custom Menu [Windows]

Post by RASHAD »

@minimy thanks
Previous post updated to simulate exact Windows behavior
Have fun :)
Egypt my love
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 456
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Custom Menu [Windows]

Post by Mindphazer »

Hi Rashad,

the popup for "Help" doesn't display under "help", so nothing can be clicked :mrgreen:
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 15.4.1 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4941
Joined: Sun Apr 12, 2009 6:27 am

Re: Custom Menu [Windows]

Post by RASHAD »

Hi Mindphazer :mrgreen:
What I am doing is to give the forum members some rest from oryaaaaa magic
Every time I get into PB forum my head was going to blow up for nothing
I wish idle do the same
i have mercy upon the new users :D
Egypt my love
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 456
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Custom Menu [Windows]

Post by Mindphazer »

Ahah
You should do what I do : I don't read oryaaaaa's threads anymore :mrgreen:
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 15.4.1 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
User avatar
Piero
Addict
Addict
Posts: 861
Joined: Sat Apr 29, 2023 6:04 pm
Location: Italy

Re: Custom Menu [Windows]

Post by Piero »

viewtopic.php?t=76588 :shock: (noob Piero had not seen that :oops: )

I wonder if that would solve at least some cross-platform problems """"""about buttons""""""…
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 456
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Custom Menu [Windows]

Post by Mindphazer »

This module certainly has great potential, but unfortunately its promotion has been (very) poorly handled by ShadowStorm....
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 15.4.1 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
PBJim
Enthusiast
Enthusiast
Posts: 293
Joined: Fri Jan 19, 2024 11:56 pm

Re: Custom Menu [Windows]

Post by PBJim »

Can you reach those sub-menu options if you have a superfast mouse? Probably my mouse is too slow. :wink:

Image
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4941
Joined: Sun Apr 12, 2009 6:27 am

Re: Custom Menu [Windows]

Post by RASHAD »

I think that the problem comes from PureBasic different versions
Try and report
Or use your own tw :D
Getting the dimensionsof a DropDown Menu not that easy
You may need Thread to catch the dimensions when it is shown
I do that only for my own business :mrgreen:

Code: Select all

Global dpix.d,dpiy.d,itemy

dpix = DesktopResolutionX()
dpiy = DesktopResolutionY()

UsePNGImageDecoder()

Procedure txtwidth(txt$)
  hdc = GetDC_(0)
  GetTextExtentPoint32_(hdc,@txt$,Len(txt$),sz.SIZE)
  tw = sz\cx * dpix
  ReleaseDC_(0, hdc)
  ProcedureReturn tw
EndProcedure

Procedure IsMouseOver(hWnd) 
  GetWindowRect_(hWnd,r.RECT) 
  GetCursorPos_(p.POINT) 
  Result = PtInRect_(r,p\y << 32 + p\x) 
  ProcedureReturn Result 
EndProcedure 

Procedure winCB(hWnd,uMsg,wParam,lParam)
  Select uMsg
    Case #WM_ENTERIDLE
      GetCursorPos_(cpt.POINT)
      hHnd = WindowFromPoint_(cpt\y<<32 + cpt\x)   
      If hHnd = hwnd Or hHnd = GadgetID(0)
        SendMessage_(hwnd, #WM_CANCELMODE,0,0)
      EndIf
      
    Case #WM_SIZE,#WM_MOVE
      ResizeGadget(0,0,0,WindowWidth(0),GadgetHeight(0))
      ResizeGadget(10,GadgetWidth(0)-58, 2, 54, itemy)
  EndSelect
  
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

OpenWindow(0, 0, 0, 600, 400, "Custom Menu", #PB_Window_SystemMenu | #PB_Window_SizeGadget |#PB_Window_ScreenCentered)
WindowBounds(0,300,200,#PB_Default,#PB_Default)
ContainerGadget(0,0,0,600,36,#PB_Container_Flat)
itemy = GadgetHeight(0)-6
SetGadgetColor(0,#PB_Gadget_BackColor,0)
TextGadget(1, 2, 2, 34, itemy,"File",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(1,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(1,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(2, 42, 2, 60, itemy,"Image",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(2,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(2,#PB_Gadget_FrontColor,$FFFFFF)    
TextGadget(10, GadgetWidth(0)-58, 2, 54, itemy,"Help",#WS_BORDER|#SS_CENTER|#SS_CENTERIMAGE|#SS_NOTIFY)
SetGadgetColor(10,#PB_Gadget_BackColor,$3D3D3D)
SetGadgetColor(10,#PB_Gadget_FrontColor,$FFFFFF)
CloseGadgetList()

CreatePopupImageMenu(0)      
MenuItem( 1, "New",LoadImage(10, #PB_Compiler_Home + "examples/sources/Data/ToolBar/New.png")) 
MenuItem( 2, "Open",LoadImage(11, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Open.png"))
MenuItem( 3, "Save",LoadImage(12, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png"))
MenuBar()
OpenSubMenu("Recents")
MenuItem( 5, "Pure.png")
MenuItem( 6, "Basic.jpg")
OpenSubMenu("Even more !")
MenuItem( 12, "Yeah")
CloseSubMenu()
MenuItem( 13, "Rocks.tga")
CloseSubMenu()
MenuBar()
MenuItem( 7, "&Quit")

CreatePopupImageMenu(1)
MenuItem( 8, "Cut",LoadImage(13, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Cut.png"))
MenuItem( 9, "Copy",LoadImage(14, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Copy.png"))
MenuItem(10, "Paste",LoadImage(15, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Paste.png"))

CreatePopupImageMenu(10)
MenuItem(11, "Contents and Index",LoadImage(16, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Find.png"))
MenuItem(12, "About")

CompilerIf #PB_Compiler_Version = 621
  tw = txtwidth("Contents and Index")+55
CompilerElse 
  tw = txtwidth("Contents and Index")
CompilerEndIf

SetWindowCallback(@winCB())

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case EventMenu()
          Debug EventMenu()          
          downflag = 0
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          DisplayPopupMenu(0, WindowID(0), GadgetX(1,#PB_Gadget_ScreenCoordinate )*dpix,yy)
          downflag = 1
        Case 2
          DisplayPopupMenu(1, WindowID(0), GadgetX(2,#PB_Gadget_ScreenCoordinate )*dpix,yy)
          downflag = 1
        Case 10
          DisplayPopupMenu(10, WindowID(0), GadgetX(10,#PB_Gadget_ScreenCoordinate )*dpix-tw,yy)
          downflag = 1
      EndSelect    
      
    Case #WM_MOUSEMOVE
      yy = (GadgetY(0,#PB_Gadget_ScreenCoordinate )+GadgetHeight(0)-3)*dpiy
      If downflag = 1
        If IsMouseOver(GadgetID(1))
          DisplayPopupMenu(0, WindowID(0), GadgetX(1,#PB_Gadget_ScreenCoordinate )*dpix,yy)
        ElseIf IsMouseOver(GadgetID(2))
          DisplayPopupMenu(1, WindowID(0), GadgetX(2,#PB_Gadget_ScreenCoordinate )*dpix,yy)
        ElseIf IsMouseOver(GadgetID(10))
          DisplayPopupMenu(10, WindowID(0), GadgetX(10,#PB_Gadget_ScreenCoordinate )*dpix-tw,yy)
        EndIf
      EndIf
  EndSelect 
Until Quit = 1
Egypt my love
Top
User avatar
minimy
Enthusiast
Enthusiast
Posts: 551
Joined: Mon Jul 08, 2013 8:43 pm
Location: off world

Re: Custom Menu [Windows]

Post by minimy »

Perfect in 6.02
Perfect in 6.21
No problems in my test. Windows 11
If translation=Error: reply="Sorry, Im Spanish": Endif
Top
Post Reply

Return to “Tricks 'n' Tips”