PureBasic Forums - English

Posted: **Thu Apr 27, 2023 9:12 am**

Hi
Please enable DPI aware check
Support Windows DPI too
Feel free to add ,remove & change
Feel the Pure Power of PB

Tested with PB 6.xx x86 - Windows 11 x64

#MNS_NOCHECK          = $80000000
#MIM_BACKGROUND       = 2
#MIM_STYLE            = $00000010
#MIM_APPLYTOSUBMENUS  = $80000000 

Structure MENUINFO Align #PB_Structure_AlignC
  cbSize.l
  fMask.l
  dwStyle.l
  cyMax.l
  hbrBack.i
  dwContextHelpId.l
  *dwMenuData
EndStructure

Global dpix.d,dpiy.d
UsePNGImageDecoder()
ExamineDesktops()
olddesktop = DesktopWidth(0)
dpix = DesktopResolutionX()
dpiy = DesktopResolutionY()

LoadImage(10, #PB_Compiler_Home + "examples/sources/Data/ToolBar/New.png")
LoadImage(11, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Open.png")
LoadImage(12, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(13, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(14, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Printpreview.png")
LoadImage(15, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Print.png")

CreateImage(0,200,400,24)
  StartDrawing(ImageOutput(0))
  Box(0,0,200,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,30,200)
  DrawAlphaImage(ImageID(10),5,5,255)
  DrawAlphaImage(ImageID(11),5,30,255)
  DrawAlphaImage(ImageID(12),5,55,255)
StopDrawing()

If OSVersion() >= #PB_OS_Windows_11
  ResizeImage(0,ImageWidth(0)*dpix,ImageHeight(0)*dpiy)
EndIf

CreateImage(1,600,400,24)
  StartDrawing(ImageOutput(1))
  Box(0,0,600,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,30,200)
  DrawAlphaImage(ImageID(13),5,5,255)
  DrawAlphaImage(ImageID(14),5,30,255)
  DrawAlphaImage(ImageID(15),5,55,255)
StopDrawing()

If OSVersion() >= #PB_OS_Windows_11
  ResizeImage(1,ImageWidth(1)*dpix,ImageHeight(1)*dpiy)
EndIf

b.LOGBRUSH
b\lbStyle = #BS_PATTERN
b\lbHatch = ImageID(0)
hBrush = CreateBrushIndirect_(b)

mi.MENUINFO
mi\cbSize = SizeOf(MENUINFO)
mi\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
mi\dwStyle = #MNS_NOCHECK
mi\hbrBack = hBrush

b2.LOGBRUSH
b2\lbStyle = #BS_PATTERN
b2\lbHatch = ImageID(1)
hBrush2 = CreateBrushIndirect_(b2)

mi2.MENUINFO
mi2\cbSize = SizeOf(MENUINFO)
mi2\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
mi2\dwStyle = #MNS_NOCHECK
mi2\hbrBack = hBrush2

If OSVersion() >= #PB_OS_Windows_11
  Text$=Space(6*dpix)
Else
  Text$=Space(6)
EndIf

Procedure sizeCB()
  ResizeGadget(0,0,0,WindowWidth(0),25)
EndProcedure

hWnd = OpenWindow(0, 0, 0, 300, 300, "New Modern Menu", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
ContainerGadget(0,0,0,WindowWidth(0),24)
SetGadgetColor(0,#PB_Gadget_BackColor,0)
  TextGadget(1,4,2,40,30,"File",#SS_NOTIFY)
  SetGadgetColor(1,#PB_Gadget_BackColor,0)
  SetGadgetColor(1,#PB_Gadget_FrontColor,$FFFFFF)
  TextGadget(2,45,2,40,30,"Edit",#SS_NOTIFY)
  SetGadgetColor(2,#PB_Gadget_BackColor,0)
  SetGadgetColor(2,#PB_Gadget_FrontColor,$FFFFFF)
CloseGadgetList()

If hWnd
  ;hMainMenu = CreateMenu_()
  CreatePopupMenu(0)
  hSubMenu = MenuID(0)
  
  ;AppendMenu_(hMainMenu, #MF_POPUP, hSubMenu, "File")
  AppendMenu_(hSubMenu, #MF_STRING, 0, Text$+"New")
  AppendMenu_(hSubMenu, #MF_STRING, 1, Text$+"Open")
  AppendMenu_(hSubMenu, #MF_STRING, 2, Text$+"Exit")
  
  CreatePopupMenu(1)
  hSubMenu2 = MenuID(1)
  ;AppendMenu_(hMainMenu, #MF_POPUP, hSubMenu2, "Edit")
  AppendMenu_(hSubMenu2, #MF_STRING, 3, Text$+"Save")
  AppendMenu_(hSubMenu2, #MF_STRING, 4, Text$+"Print Preview")
  AppendMenu_(hSubMenu2, #MF_STRING, 5, Text$+"Print") 
 
  SetMenuInfo_(hSubMenu, mi)
  SetMenuInfo_(hSubMenu2, mi2)
  
  BindEvent(#PB_Event_SizeWindow,@sizeCB())
  ;SetMenu_(hWnd, hMainMenu)
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
        
      Case #PB_Event_Menu
        Debug EventMenu()
        Select EventMenu()
        EndSelect
        
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            DisplayPopupMenu(0,WindowID(0),GadgetX(1,#PB_Gadget_ScreenCoordinate)*dpix,GadgetY(1,#PB_Gadget_ScreenCoordinate)*dpiy+24*dpiy)
          Case 2
            DisplayPopupMenu(1,WindowID(0),GadgetX(2,#PB_Gadget_ScreenCoordinate)*dpix,GadgetY(2,#PB_Gadget_ScreenCoordinate)*dpiy+24*dpiy)
        EndSelect
    EndSelect
  Until Quit = 1
          
EndIf

Edit :Fixed the font size in the Windows different versions

Posted: **Thu Apr 27, 2023 9:20 am**

Thanks, but it needs some work:

Text is covered by the gradient (should be more to the right).

No icon appears for the print preview, despite one being loaded.

The icon backgrounds aren't transparent either (see the white behind the printer).

Sorry to do this to you, Rashad.

Posted: **Thu Apr 27, 2023 9:25 am**

You probably need to use MEASURE_ITEM to have correct width/height in DPI mode (> 100%). You should also use DrawAlphaImage() instead of DrawImage() to properly handle transparency.

Posted: **Thu Apr 27, 2023 10:13 am**

Previous post updated
Change the DPI scale Before running the snippet
Tested with PB 6.xx x86 - Windows 11 x64
Works as expected
If you have any remark please inform about your System configuration

Posted: **Thu Apr 27, 2023 11:04 am**

Previous post updated to deal with Windows different versions
Windows 11 adapt the size of the text font for it's components [Menu,PopupMenu,StatusBar etc..] responding to the DPI Scale
Tested with VM Windows 7,8.1,10,11

Posted: **Thu Apr 27, 2023 11:16 am**

I am using font 11. MenuHeight()? Win10x64, scale 100%

Code: Select all

Global mh = MenuHeight() 
; ...
  DrawAlphaImage(ImageID(10),5,3,255)
  DrawAlphaImage(ImageID(11),5,1 + mh,255)
  DrawAlphaImage(ImageID(12),5,1 + mh * 2,255)
  ; ...
  ResizeGadget(0,0,0,WindowWidth(0),mh)
  ; ...
  ContainerGadget(0,0,0,WindowWidth(0),mh)
  
  ; ...  *dpiy+mh*dpiy)
  ; ... *dpiy+mh*dpiy)

Posted: **Thu Apr 27, 2023 11:56 am**

Enabled DPI in Compiler Options, but I still get the same image as my screenshot except that the menu background is now black. The icon backgrounds are now transparent though - yay!

However, the menus don't change after I click one and hover over the other, like a normal menu does.

Using Win 10 Pro, and my DPI scale is 100% and no, it's not good to expect the user to change that to make it work ("Change the DPI scale Before running the snippet").

Posted: **Thu Apr 27, 2023 2:44 pm**

No DPI Scale for now until we finish the menu behavior

Code: Select all

#MNS_NOCHECK          = $80000000
#MIM_BACKGROUND       = 2
#MIM_STYLE            = $00000010
#MIM_APPLYTOSUBMENUS  = $80000000 

Structure MENUINFO Align #PB_Structure_AlignC
  cbSize.l
  fMask.l
  dwStyle.l
  cyMax.l
  hbrBack.i
  dwContextHelpId.l
  *dwMenuData
EndStructure

Global dpix.d,dpiy.d,oldgad
UsePNGImageDecoder()
ExamineDesktops()
olddesktop = DesktopWidth(0)
dpix = DesktopResolutionX()
dpiy = DesktopResolutionY()

LoadImage(30, #PB_Compiler_Home + "examples/sources/Data/ToolBar/New.png")
LoadImage(31, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Open.png")
LoadImage(32, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(33, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(34, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Printpreview.png")
LoadImage(35, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Print.png")

CreateImage(10,200,400,24)
  StartDrawing(ImageOutput(10))
  Box(0,0,200,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,30,200)
  DrawAlphaImage(ImageID(30),5,5,255)
  DrawAlphaImage(ImageID(31),5,30,255)
  DrawAlphaImage(ImageID(32),5,55,255)
StopDrawing()

CreateImage(20,600,400,24)
  StartDrawing(ImageOutput(20))
  Box(0,0,600,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,30,200)
  DrawAlphaImage(ImageID(33),5,5,255)
  DrawAlphaImage(ImageID(34),5,30,255)
  DrawAlphaImage(ImageID(35),5,55,255)
StopDrawing()

LoadFont(0,"Georgia",10,#PB_Font_Bold)

For i = 1 To 3
  CreateImage(i,60,22,24,$808080)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 1                                
    DrawText(18,2,"File",$FFFFFF)
  ElseIf i = 2
    DrawText(3,2,"Edition",$FFFFFF)
  Else
    DrawText(12,2,"Help",$FFFFFF)
  EndIf
  StopDrawing()
Next

For i = 4 To 6
  CreateImage(i,60,22,24,$FFCC99)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 4                                
    DrawText(18,2,"File",$151FFE)
  ElseIf i = 5
    DrawText(3,2,"Edition",$151FFE)
  Else
    DrawText(12,2,"Help",$151FFE)
  EndIf
  StopDrawing()
Next

For i = 7 To 9
  CreateImage(i,60,22,24,$808080)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 7                                
    DrawText(18,2,"File",$C7C7C8)
  ElseIf i = 8
    DrawText(3,2,"Edition",$C7C7C8)
  Else
    DrawText(12,2,"Help",$C7C7C8)
  EndIf
  StopDrawing()
Next

b.LOGBRUSH
b\lbStyle = #BS_PATTERN
b\lbHatch = ImageID(10)
hBrush = CreateBrushIndirect_(b)

mi.MENUINFO
mi\cbSize = SizeOf(MENUINFO)
mi\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
mi\dwStyle = #MNS_NOCHECK
mi\hbrBack = hBrush

b2.LOGBRUSH
b2\lbStyle = #BS_PATTERN
b2\lbHatch = ImageID(20)
hBrush2 = CreateBrushIndirect_(b2)

mi2.MENUINFO
mi2\cbSize = SizeOf(MENUINFO)
mi2\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
mi2\dwStyle = #MNS_NOCHECK
mi2\hbrBack = hBrush2

If OSVersion() >= #PB_OS_Windows_11
  Text$=Space(6*dpix)
Else
  Text$=Space(6)
EndIf

Procedure sizeCB()
  ResizeGadget(0,0,0,WindowWidth(0),20)
EndProcedure

Procedure WindowCallback(hWnd,uMsg,wParam,lParam)
    Select uMsg 
      Case #WM_ENTERIDLE
        GetCursorPos_(cpt.POINT)    
        gad = WindowFromPoint_(cpt\y<<32 + cpt\x)
        If gad = Hwnd Or gad = GadgetID(0)
          EndMenu_()          
          SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
          SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))      
        EndIf
    EndSelect 
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

hWnd = OpenWindow(0, 0, 0, 300, 300, "New Modern Menu", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
ContainerGadget(0,0,0,400,20)
  CanvasGadget(1,0,0,60,20)
  SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
  CanvasGadget(2,70,0,60,20)
  SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))
CloseGadgetList()
SetGadgetColor(0,#PB_Gadget_BackColor,$808080)

If hWnd
  CreatePopupMenu(10)
  hSubMenu = MenuID(10)  
  
  AppendMenu_(hSubMenu, #MF_STRING, 0, Text$+"New")
  AppendMenu_(hSubMenu, #MF_STRING, 1, Text$+"Open")
  AppendMenu_(hSubMenu, #MF_STRING, 2, Text$+"Exit")
  
  CreatePopupMenu(20)
  hSubMenu2 = MenuID(20)
  AppendMenu_(hSubMenu2, #MF_STRING, 3, Text$+"Save")
  AppendMenu_(hSubMenu2, #MF_STRING, 4, Text$+"Print Preview")
  AppendMenu_(hSubMenu2, #MF_STRING, 5, Text$+"Print") 
 
  SetMenuInfo_(hSubMenu, mi)
  SetMenuInfo_(hSubMenu2, mi2)
  
  BindEvent(#PB_Event_SizeWindow,@sizeCB())
  SetWindowCallback(@WindowCallback())
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
        
      Case #WM_MOUSEMOVE         
        GetCursorPos_ (@p.POINT) 
        ScreenToClient_ (WindowID(0), @p)              
        hGad = ChildWindowFromPoint_ (WindowID(0), p\y<< 32+p\x)
        If hGad =  GadgetID(0) 
          hgad = ChildWindowFromPoint_ (GadgetID(0), p\y<< 32+p\x)
          SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
          SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))                
          Select hGad                  
            Case GadgetID(1)
              SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(4))                     
              DisplayPopupMenu(10,WindowID(0),GadgetX(1,#PB_Gadget_ScreenCoordinate),GadgetY(1,#PB_Gadget_ScreenCoordinate)+20)	
            Case GadgetID(2)
              SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(5)) 
              DisplayPopupMenu(20,WindowID(0),GadgetX(2,#PB_Gadget_ScreenCoordinate),GadgetY(2,#PB_Gadget_ScreenCoordinate)+20)
          EndSelect
        EndIf
        
      Case #PB_Event_Menu
        SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
        SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2)) 
        Debug EventMenu()
        Select EventMenu()
        
        EndSelect

    EndSelect
  Until Quit = 1
          
EndIf

Posted: **Fri Apr 28, 2023 5:49 am**

Fred wrote: Thu Apr 27, 2023 9:25 am You probably need to use MEASURE_ITEM to have correct width/height in DPI mode (> 100%). You should also use DrawAlphaImage() instead of DrawImage() to properly handle transparency.

You're right Fred.
I have been writing a personal lib for more than 10 years now to manage Menu/PopupMenu ans system Menu (window only).
The size of the menu/popup/system Menu window depends on the length of the text and the font used.
It would be nice to have a set of function for system menus.
It is also possible to define the colour/size of the Menu/popupMenu/systemMenu separation bars.
Here looks like that with my lib (sytem menu from PureIconManager.exe).

Posted: **Fri Apr 28, 2023 6:42 am**

POP-UP Menu problems :
- The Row Height for the POP-UP Menu is different for Windows 11 than Windows XP,7,8,8.1 & 10
- And it get worth if the User Changed the TEXT Scale
- And more worth that you can't get the POP-UP Menu dimension when no visible Menu
- Now I did my best to overcome all the previous mentioned problems
- I am not going to get any further for this post
- Only maybe for myself I will enhance it

Code: Select all

#MNS_NOCHECK          = $80000000
#MIM_BACKGROUND       = 2
#MIM_STYLE            = $00000010
#MIM_APPLYTOSUBMENUS  = $80000000 

Structure MENUINFO Align #PB_Structure_AlignC
  cbSize.l
  fMask.l
  dwStyle.l
  cyMax.l
  hbrBack.i
  dwContextHelpId.l
  *dwMenuData
EndStructure

Global dpix.d,dpiy.d,oldgad,run,rowh
Global b.LOGBRUSH,mi.MENUINFO
UsePNGImageDecoder()
ExamineDesktops()
olddesktop = DesktopWidth(0)
dpix = DesktopResolutionX()
dpiy = DesktopResolutionY()

LoadImage(30, #PB_Compiler_Home + "examples/sources/Data/ToolBar/New.png")
LoadImage(31, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Open.png")
LoadImage(32, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(33, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png")
LoadImage(34, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Printpreview.png")
LoadImage(35, #PB_Compiler_Home + "examples/sources/Data/ToolBar/Print.png")


Procedure POPMENU(value) 
CreateImage(10,200,400,24)
  StartDrawing(ImageOutput(10))
  Box(0,0,200,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,value,200)
  DrawAlphaImage(ImageID(30),5,0,255)
  DrawAlphaImage(ImageID(31),5,value,255)
  DrawAlphaImage(ImageID(32),5,value*2,255)
StopDrawing()

CreateImage(20,200,400,24)
  StartDrawing(ImageOutput(20))
  Box(0,0,600,400,$D8FEFE)
  DrawingMode(#PB_2DDrawing_Gradient)      
  BackColor($FF0000)
  FrontColor($00FFFF)      
  BoxedGradient(-5, -100, 100, 400)  
  Box(0,0,value,200)
  DrawAlphaImage(ImageID(33),5,0,255)
  DrawAlphaImage(ImageID(34),5,value,255)
  DrawAlphaImage(ImageID(35),5,value*2,255)
StopDrawing()

  b.LOGBRUSH
  b\lbStyle = #BS_PATTERN
  b\lbHatch = ImageID(10)
  hBrush = CreateBrushIndirect_(b)
  
  mi.MENUINFO
  mi\cbSize = SizeOf(MENUINFO)
  mi\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
  mi\dwStyle = #MNS_NOCHECK
  mi\hbrBack = hBrush
  
  b.LOGBRUSH
  b\lbStyle = #BS_PATTERN
  b\lbHatch = ImageID(20)
  hBrush2 = CreateBrushIndirect_(b)
  
  mi.MENUINFO
  mi\cbSize = SizeOf(MENUINFO)
  mi\fMask = #MIM_STYLE| #MIM_BACKGROUND |#MIM_APPLYTOSUBMENUS
  mi\dwStyle = #MNS_NOCHECK
  mi\hbrBack = hBrush

EndProcedure

LoadFont(0,"Georgia",10,#PB_Font_Bold)

For i = 1 To 3
  CreateImage(i,60,22,24,$808080)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 1                                
    DrawText(18,2,"File",$FFFFFF)
  ElseIf i = 2
    DrawText(3,2,"Edition",$FFFFFF)
  Else
    DrawText(12,2,"Help",$FFFFFF)
  EndIf
  StopDrawing()
Next

For i = 4 To 6
  CreateImage(i,60,22,24,$FFCC99)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 4                                
    DrawText(18,2,"File",$151FFE)
  ElseIf i = 5
    DrawText(3,2,"Edition",$151FFE)
  Else
    DrawText(12,2,"Help",$151FFE)
  EndIf
  StopDrawing()
Next

For i = 7 To 9
  CreateImage(i,60,22,24,$808080)
  StartDrawing(ImageOutput(i))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  If i = 7                                
    DrawText(18,2,"File",$C7C7C8)
  ElseIf i = 8
    DrawText(3,2,"Edition",$C7C7C8)
  Else
    DrawText(12,2,"Help",$C7C7C8)
  EndIf
  StopDrawing()
Next

If OSVersion() >= #PB_OS_Windows_11
  Text$=Space(6*dpix)
Else
  Text$="      "
EndIf

Procedure sizeCB()
  ResizeGadget(0,0,0,WindowWidth(0),20)
EndProcedure

Procedure WindowCallback(hWnd,uMsg,wParam,lParam)
    Select uMsg 
      Case #WM_ENTERIDLE
        GetCursorPos_(cpt.POINT)    
        gad = WindowFromPoint_(cpt\y<<32 + cpt\x)
        If gad = Hwnd Or gad = GadgetID(0)
          SendMessage_(WindowID(0), #WM_CANCELMODE,0,0)
          SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
          SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))      
        EndIf
        
      Case #WM_INITMENUPOPUP
        If run = 0
          run = 1
          hWndMenu = FindWindow_("#32768", #Null)
          nMenuSize = SendMessage_(hWndMenu, $1E2, 1, 0)
          nWidth = (nMenuSize & $FFFF) + GetSystemMetrics_(#SM_CXFIXEDFRAME) * 2
          nHeight = (nMenuSize >> 16); + GetSystemMetrics_(#SM_CYFIXEDFRAME) * 2
          rowh = nHeight/GetMenuItemCount_(MenuID(10))
          EndMenu_()
        EndIf
    EndSelect 
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

hWnd = OpenWindow(0, 0, 0, 300, 300, "New Modern Menu", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
ContainerGadget(0,0,0,400,20)
  CanvasGadget(1,0,0,60,20)
  SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
  CanvasGadget(2,70,0,60,20)
  SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))
CloseGadgetList()
SetGadgetColor(0,#PB_Gadget_BackColor,$808080)   
If hWnd
  CreatePopupMenu(10)
  hSubMenu = MenuID(10)  
  AppendMenu_(hSubMenu, #MF_STRING, 0, Text$+"New")
  AppendMenu_(hSubMenu, #MF_STRING, 1, Text$+"Open")
  AppendMenu_(hSubMenu, #MF_STRING, 2, Text$+"Exit")
  
  CreatePopupMenu(20)
  hSubMenu2 = MenuID(20)
  AppendMenu_(hSubMenu2, #MF_STRING, 3, Text$+"Save")
  AppendMenu_(hSubMenu2, #MF_STRING, 4, Text$+"Print Preview")
  AppendMenu_(hSubMenu2, #MF_STRING, 5, Text$+"Print") 
  POPMENU(17)
  SetMenuInfo_(hSubMenu, mi)
  SetMenuInfo_(hSubMenu2, mi)
EndIf
BindEvent(#PB_Event_SizeWindow,@sizeCB())
SetWindowCallback(@WindowCallback())
DisplayPopupMenu(10,WindowID(0),0,0)

  POPMENU(rowh)
  SetMenuInfo_(hSubMenu, mi)
  SetMenuInfo_(hSubMenu2, mi)
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
        
      Case #WM_MOUSEMOVE          
        GetCursorPos_ (@p.POINT) 
        ScreenToClient_ (WindowID(0), @p)              
        hGad = ChildWindowFromPoint_ (WindowID(0), p\y<< 32+p\x)
        If hGad =  GadgetID(0) 
          hgad = ChildWindowFromPoint_ (GadgetID(0), p\y<< 32+p\x)
          SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
          SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2))                
          Select hGad                  
            Case GadgetID(1)
              SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(4))                     
              DisplayPopupMenu(10,WindowID(0),GadgetX(1,#PB_Gadget_ScreenCoordinate),GadgetY(1,#PB_Gadget_ScreenCoordinate)+20)	
            
            Case GadgetID(2)
              SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(5)) 
              DisplayPopupMenu(20,WindowID(0),GadgetX(2,#PB_Gadget_ScreenCoordinate),GadgetY(2,#PB_Gadget_ScreenCoordinate)+20)
          EndSelect
        EndIf
        
      Case #PB_Event_Menu
        SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1))
        SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2)) 
        Debug EventMenu()
        Select EventMenu()
        
        EndSelect

    EndSelect
  Until Quit = 1

Posted: **Fri Apr 28, 2023 7:11 am**

RASHAD wrote: Fri Apr 28, 2023 6:42 am - And more worth that you can't get the POP-UP Menu dimension when no visible Menu

Maybe you can attach a var to the memu/menu item and store dimensions when you catch #WM_MEASUREITEM

I don't know if it will help you, here it is the #WM_MEASUREITEM part of my code (sorry comments in French).
I use font and i delete it after calculating size.

Code: Select all

                  ;- .  --->   #WM_MEASUREITEM
            Case #WM_MEASUREITEM
                  *mi.MEASUREITEMSTRUCT = lParam
                  If *mi\CtlType = #ODT_MENU
                        
                        If *mi\itemdata
                              hDC = GetDC_(hWnd)
                              If hDC
                                    SavedDC = SaveDC_(hDC)
                              EndIf
                              
                              ;// on recherche si le menu est un élément de la barre de menu
                              *Variable.item = *mi\itemdata
                              
                              If (*Variable\type = #TypeMenuBar) Or (*Variable\type = #TypeSystemMenuBar)
                                    *mi\itemwidth = 10 ;// taille mini de la barre s'il n'y a pas de texte ou si une lettre
                                    *mi\itemheight = #epaisseur_MenuBarre
                              Else
                                    ;// GetTabbedTextExtent_
                                    ;// ms-help://MS.PSDK.1033/gdi/fontext_8f6t.htm
                                    
                                    ;// on teste si une font est définie
                                    If *Variable\FontId And GetObject_(*Variable\FontId, SizeOf(LOGFONT), @lpvObject.LOGFONT)
                                          ;// la font a été définie
                                          If *Variable\SelectedFont & #PB_Font_Bold Or *Variable.item\idstatic = #SC_CLOSE
                                                SelectedFont = CreateFont(*Variable\FontId, *Variable\SelectedFont | #PB_Font_Bold)
                                          Else
                                                SelectedFont = CreateFont(*Variable\FontId, *Variable\SelectedFont)
                                          EndIf
                                    Else ;// la font n'est pas définie, on utilise la font par défaut
                                          If *Variable\SelectedFont & #PB_Font_Bold Or *Variable.item\idstatic = #SC_CLOSE
                                                SelectedFont = CreateFont(Defaut_Font, *Variable\SelectedFont | #PB_Font_Bold)
                                          Else
                                                SelectedFont = CreateFont(Defaut_Font, *Variable\SelectedFont)
                                          EndIf
                                    EndIf
                                    
                                    Count = CountString(*Variable\text, "&")
                                    If Count = 0
                                          *Variable\text + "&"
                                    EndIf
                                    
                                    SelectObject_(hDC, SelectedFont)
                                    
                                    GetTextExtentPoint32_(hDC, *Variable\text, Len(*Variable\text), sz.SIZE)
                                    If Count = 0
                                          *Variable\text = Left(*Variable\text, Len(*Variable\text)-1)
                                    EndIf
                                    
                                    ;// la destruction de la font doit se faire après le calcul de la taille !
                                    If SelectedFont
                                          DeleteObject_(SelectedFont)
                                    EndIf
                                    
                                    ;// fixe la hauteur mini
                                    If sz\cy<20
                                          sz\cy = 20
                                    Else
                                          If sz\cy & 1 ;// nombre impair
                                                sz\cy + 1
                                          EndIf
                                    EndIf
                                    
                                    ;// calcul de la largeur à donner à l'élément
                                    ;// sachant que au minimum la taille du caractère &
                                    ;// #offset_texte_par_rapport_zone_ico = 10 --> décalage par rapport à la zone ico
                                    ;// #position_X_Text = #largeur_zone_icone + #offset_texte_par_rapport_zone_ico
                                    
                                    *mi\itemWidth = sz\cx + largeur_zone_icone + (2*#offset_texte_par_rapport_zone_ico) ;// la taille du texte brut
                                    
                                    If (*Variable\type = #TypeSystemSubMenuItem)
                                          ;// la taille de la zone ico + 2 fois l'offset (10 de chaque côté
                                          
                                          *mi\itemWidth + 40 ;// 40 c'est pour la taille de la flèche système du submenu
                                          
                                          
                                          ;// ;//                                   *mi\itemWidth = *mi\itemWidth + (2 * #offset_texte_par_rapport_zone_ico)+largeur_zone_icone
                                          ;// *mi\itemWidth = *mi\itemWidth  ;//+largeur_zone_icone
                                          
                                    EndIf
                                    
                                    Count = CountString(*Variable\text, Chr(9))
                                    If Count
                                          *mi\itemWidth + 20
                                    EndIf
                                    
                                    If sz\cy>Hauteur_Ligne_Mini
                                          *mi\itemHeight = sz\cy
                                          If *mi\itemHeight & 1
                                                *mi\itemHeight + 1
                                          EndIf
                                    Else
                                          *mi\itemHeight = Hauteur_Ligne_Mini
                                    EndIf
                                    
                              EndIf
                              If SavedDC
                                    RestoreDC_(hDC, SavedDC)
                              EndIf
                              
                              ReleaseDC_(hWnd, hDC)
                        EndIf
                        ProcedureReturn 1
                  EndIf

Posted: **Sun Apr 30, 2023 6:57 pm**

Works nice here with W10 and v5.73 LTS
Thanks for sharing this nice piece of code

PureBasic Forums - English

New Modern Windows Menu [Windows]

New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]

Re: New Modern Windows Menu [Windows]