PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Custom Menu [Windows]

https://www.purebasic.fr/english/viewtopic.php?t=87197

Page 1 of 2

Custom Menu [Windows]

Posted: Mon Jul 21, 2025 3:59 am
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

Re: Custom Menu [Windows]

Posted: Mon Jul 21, 2025 7:50 am
by Little John
Looks good. :thumbsup: Thanks for sharing! :-)

Re: Custom Menu [Windows]

Posted: Mon Jul 21, 2025 7:57 am
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 ...

Re: Custom Menu [Windows]

Posted: Mon Jul 21, 2025 8:53 am
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

Re: Custom Menu [Windows]

Posted: Mon Jul 21, 2025 9:41 am
by RASHAD
Thanks guys :)
Previous post updated

Re: Custom Menu [Windows]

Posted: Mon Jul 21, 2025 3:35 pm
by minimy
Nice example RASHAD, as allways.
Thanks for share!

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 10:13 am
by RASHAD
@minimy thanks
Previous post updated to simulate exact Windows behavior
Have fun :)

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 11:31 am
by Mindphazer
Hi Rashad,

the popup for "Help" doesn't display under "help", so nothing can be clicked :mrgreen:

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 12:24 pm
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

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 12:29 pm
by Mindphazer
Ahah
You should do what I do : I don't read oryaaaaa's threads anymore :mrgreen:

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 12:32 pm
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""""""…

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 1:28 pm
by Mindphazer
This module certainly has great potential, but unfortunately its promotion has been (very) poorly handled by ShadowStorm....

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 3:12 pm
by PBJim
Can you reach those sub-menu options if you have a superfast mouse? Probably my mouse is too slow. :wink:

Image

Re: Custom Menu [Windows]

Posted: Tue Jul 22, 2025 7:06 pm
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

Re: Custom Menu [Windows]

Posted: Wed Jul 23, 2025 5:48 pm
by minimy
Perfect in 6.02
Perfect in 6.21
No problems in my test. Windows 11
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited