Custom & Stylish Menu [Windows]

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

Custom & Stylish Menu [Windows]

Post by RASHAD »

Everything can be changed to your taste
Colors,Fonts,Sizes,Positions .........etc

Code: Select all


#TPM_CENTERALIGN  = $4
#TPM_VCENTERALIGN = $10

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

Procedure SetImage(iMenu, iID, ico)
  ExtractIconEx_("shell32.dll", ico, 0, @iIcon, 1)
  im=CreateImage(#PB_Any, 16, 16 ,32)
  StartDrawing(ImageOutput(im))
     Box(0, 0, 16, 16, GetSysColor_(#COLOR_MENU))
     DrawingMode(#PB_2DDrawing_AllChannels)
     DrawImage(iIcon, 0, 0, 16, 16)
  StopDrawing()
  DestroyIcon_(iIcon)
  ProcedureReturn im
EndProcedure

Procedure MouseProc(nCode, wParam, lParam)
  Static lastgad
  *ms.MOUSEHOOKSTRUCT = lParam
  If wParam = #WM_MOUSEMOVE
          GetCursorPos_ (@p.POINT) 
          ScreenToClient_ (WindowID(0), @p)              
          hGad = ChildWindowFromPoint_ (GadgetID(0), p\y<< 32+p\x)
          If hGad <> Lastgad And hGad <> 0
              SetGadgetColor(GetDlgCtrlID_(Lastgad),#PB_Gadget_BackColor,$808080)
              SetGadgetColor(GetDlgCtrlID_(Lastgad),#PB_Gadget_FrontColor,$FFFFFF)
              keybd_event_(#VK_ESCAPE,0,#KEYEVENTF_EXTENDEDKEY,0)
              keybd_event_(#VK_ESCAPE,0,#KEYEVENTF_KEYUP|#KEYEVENTF_EXTENDEDKEY,0)
          EndIf
          Select hGad
              Case GadgetID(1)
                  Lastgad = GadgetID(1)
                  SetGadgetColor(1,#PB_Gadget_BackColor,$FFCC99)
                  SetGadgetColor(1,#PB_Gadget_FrontColor,$151FFE)                  
                  TrackPopupMenu_(GetSubMenu_(MenuID(0),0), #TPM_CENTERALIGN | #TPM_VCENTERALIGN ,WindowX(0) + GadgetX(1) + 62, WindowY(0) + GadgetY(0) + 114,0,  WindowID(0), 0)

              Case GadgetID(2)
                  Lastgad = GadgetID(2)
                  SetGadgetColor(2,#PB_Gadget_BackColor,$FFCC99)
                  SetGadgetColor(2,#PB_Gadget_FrontColor,$151FFE)       
                  TrackPopupMenu_(GetSubMenu_(MenuID(0),1), #TPM_CENTERALIGN | #TPM_VCENTERALIGN , WindowX(0) + GadgetX(2) + 46 , WindowY(0) + GadgetY(0) + 84,0,  WindowID(0), 0)
                  
              Case GadgetID(3)
                  Lastgad = GadgetID(3)
                  SetGadgetColor(3,#PB_Gadget_BackColor,$FFCC99)
                  SetGadgetColor(3,#PB_Gadget_FrontColor,$151FFE)       
                  TrackPopupMenu_(GetSubMenu_(MenuID(0),2), #TPM_CENTERALIGN | #TPM_VCENTERALIGN , WindowX(0) + WindowWidth(0) - 66 , WindowY(0) + GadgetY(0) + 74,0,  WindowID(0), 0)
;                   GetMenuItemRect_(WindowID(0),GetSubMenu_(MenuID(0),2),1,r.RECT)
;                   PopupMenuWidth = r\right-r\left
;                   Debug PopupMenuWidth
                  
          EndSelect
  ElseIf wParam = #WM_LBUTTONDOWN
         SetGadgetColor(GetDlgCtrlID_(Lastgad),#PB_Gadget_BackColor,$808080)
         SetGadgetColor(GetDlgCtrlID_(Lastgad),#PB_Gadget_FrontColor,$FFFFFF)
  EndIf
  ProcedureReturn result
EndProcedure

If OpenWindow(0, 0, 0, 400, 300, "PureBasic - Menu",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)


  If CreateImageMenu(0, WindowID(0));,#PB_Menu_ModernLook)
      MenuTitle("File")
      MenuItem( 1, "&Load...",ImageID(SetImage(GetSubMenu_(MenuID(0),0), 0, 4)))
      MenuItem( 2, "Save",ImageID(SetImage(GetSubMenu_(MenuID(0),0), 1, 130)))
      MenuItem( 3, "Save As...",ImageID(SetImage(GetSubMenu_(MenuID(0),0), 2, 194)))
      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")

    MenuTitle("Edition")
      MenuItem( 8, "Cut",ImageID(SetImage(GetSubMenu_(MenuID(0),1), 0, 4)))
      MenuItem( 9, "Copy",ImageID(SetImage(GetSubMenu_(MenuID(0),1), 1, 43)))
      MenuItem(10, "Paste",ImageID(SetImage(GetSubMenu_(MenuID(0),1), 2, 10)))
      
    MenuTitle("Help")
      MenuItem(11, "Contents and Index",ImageID(SetImage(GetSubMenu_(MenuID(0),2), 3, 90)))
      MenuItem(12, "About")

  EndIf
  

  SetMenu_(WindowID(0),0)
  ContainerGadget(0,0,0,195,20,#PB_Container_BorderLess)
  TextGadget(1,0,0,60,20,"File",#SS_CENTERIMAGE | #SS_CENTER)
  TextGadget(2,60,0,60,20,"Edition",#SS_CENTERIMAGE | #SS_CENTER)
  TextGadget(3, 0,0,0,0,"Help",#SS_CENTERIMAGE | #SS_CENTER)
  CloseGadgetList()
  SetGadgetFont(1,FontID(0))
  SetGadgetFont(2,FontID(0))
  SetGadgetFont(3,FontID(0))
  SetGadgetColor(0,#PB_Gadget_BackColor,$808080)
  SetGadgetColor(1,#PB_Gadget_BackColor,$808080)
  SetGadgetColor(2,#PB_Gadget_BackColor,$808080)
  SetGadgetColor(3,#PB_Gadget_BackColor,$808080)
  SetGadgetColor(1,#PB_Gadget_FrontColor,$FFFFFF)
  SetGadgetColor(2,#PB_Gadget_FrontColor,$FFFFFF)
  SetGadgetColor(3,#PB_Gadget_FrontColor,$FFFFFF)
  
 
  lpdwProcessId = GetWindowThreadProcessId_(WindowID(0), 0)
  hhook = SetWindowsHookEx_(#WH_MOUSE, @MouseProc(),GetModuleHandle_(0), lpdwProcessId)  

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_SizeWindow
          ResizeGadget(0,0,0,WindowWidth(0),20)
          ResizeGadget(3,WindowWidth(0)-60,0,60,20)
        

      Case #PB_Event_Gadget

        Select EventGadget() 

          Case 4
            
          Case 2

        EndSelect

      Case #PB_Event_CloseWindow
        Quit = 1

    EndSelect

  Until Quit = 1

EndIf

End
Egypt my love
Top
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:
Contact Zebuddi123

Re: Custom & Stylish Menu [Windows]

Post by Zebuddi123 »

Thank RASHAD for sharing very nice great addition


Zebuddi. :D
malleo, caput, bang. Ego, comprehendunt in tempore
Top
User avatar
charvista
Addict
Addict
Posts: 943
Joined: Tue Sep 23, 2008 11:38 pm
Location: Belgium

Re: Custom & Stylish Menu [Windows]

Post by charvista »

RASHAD, I love you :mrgreen:
Now I will sleep well tonight :wink:

A small pity that the submenu "Recent>" is still appearing left under Win8...
- Windows 11 Home 64-bit
- PureBasic 6.10 LTS (x64)
- 64 Gb RAM
- 13th Gen Intel(R) Core(TM) i9-13900K 3.00 GHz
- 5K monitor with DPI @ 200%
Top
jassing
Addict
Addict
Posts: 1775
Joined: Wed Feb 17, 2010 12:00 am

Re: Custom & Stylish Menu [Windows]

Post by jassing »

Nice idea - but it would be nice if the main menu bar "ate up" any mouse clicks -- I (appear to be) a creature of habit -- even tho mousing over the menu bar item shows the sub menu; I still found myself prone to clicking the menu bar, which removed the sub menu.
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4664
Joined: Sun Apr 12, 2009 6:27 am

Re: Custom & Stylish Menu [Windows]

Post by RASHAD »

Thanks guys
Well ,it needs to be improved no doubt
I will try to accomplish the mission

Next is a cross-platform using CavasGadget() to manipulate mouse move
(I am not sure about it ,you got to check)
Except for extracting the icons and install it as images ,so have to use your own icons for now
You will notice that you have to click the menu item (Till I find a way to activate Mouse Hover Cross-Platform)

Code: Select all


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

Procedure SetImage(iMenu, iID, ico)
  ExtractIconEx_("shell32.dll", ico, 0, @iIcon, 1)
  im=CreateImage(#PB_Any, 16, 16 ,32)
  StartDrawing(ImageOutput(im))
     Box(0, 0, 16, 16, GetSysColor_(#COLOR_MENU))
     DrawingMode(#PB_2DDrawing_AllChannels)
     DrawImage(iIcon, 0, 0, 16, 16)
  StopDrawing()
  DestroyIcon_(iIcon)
  ProcedureReturn im
EndProcedure

If OpenWindow(0, 0, 0, 400, 300, "PureBasic - Menu",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)

      CreatePopupImageMenu(1) 
      MenuItem( 1, "&Load...",ImageID(SetImage(GetSubMenu_(MenuID(1),0), 0, 4)))
      MenuItem( 2, "Save",ImageID(SetImage(GetSubMenu_(MenuID(1),0), 1, 130)))
      MenuItem( 3, "Save As...",ImageID(SetImage(GetSubMenu_(MenuID(1),0), 2, 194)))
      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(2)
      MenuItem( 8, "Cut",ImageID(SetImage(GetSubMenu_(MenuID(2),1), 0, 4)))
      MenuItem( 9, "Copy",ImageID(SetImage(GetSubMenu_(MenuID(2),1), 1, 43)))
      MenuItem(10, "Paste",ImageID(SetImage(GetSubMenu_(MenuID(2),1), 2, 10)))
      
      CreatePopupImageMenu(3)
      MenuItem(11, "Contents and Index",ImageID(SetImage(GetSubMenu_(MenuID(2),2), 3, 90)))
      MenuItem(12, "About")

  TextGadget(0, 0,0,0,0,"")
  CanvasGadget(1,0,0,60,22)
  CanvasGadget(2,60,0,60,22)
  CanvasGadget(3, 0,0,60,22)
  SetGadgetColor(0,#PB_Gadget_BackColor,$808080)
  
  For i = 1 To 3
     StartDrawing(CanvasOutput(i))
        Box(0,0,60,22,$808080)
        DrawingFont(FontID(0))
        DrawingMode(#PB_2DDrawing_Transparent)
        If i = 1           
           DrawText(18,2,"File",$FFFFFF)
        ElseIf i = 2           
           DrawText(4,2,"Edition",$FFFFFF)
        ElseIf i = 3
           DrawText(14,2,"Help",$FFFFFF)
        EndIf
     StopDrawing()
  Next

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_SizeWindow          
          ResizeGadget(3,WindowWidth(0)-60,0,60,22)
          ResizeGadget(0,GadgetX(2)+60,0,GadgetX(3)-GadgetX(2) - 60,22)
        

      Case #PB_Event_Gadget
        Select EventGadget()              
          Case 1
             Select EventType()
                Case #PB_EventType_MouseEnter
                        StartDrawing(CanvasOutput(1))
                          Box(0,0,60,22,$FFCC99)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)                                
                          DrawText(18,2,"File",$151FFE)
                       StopDrawing()
                      DisplayPopupMenu(1,WindowID(0),WindowX(0) + GadgetX(1) + 8, WindowY(0) + 50)
                      
                Case  #PB_EventType_MouseLeave
                        StartDrawing(CanvasOutput(1))
                          Box(0,0,60,22,$808080)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)                                
                          DrawText(18,2,"File",$FFFFFF)
                       StopDrawing()
                      
                Case #PB_EventType_MouseMove 
                     Debug GetGadgetAttribute(1, #PB_Canvas_MouseX) 
                     Debug GetGadgetAttribute(1, #PB_Canvas_MouseY)
              EndSelect   
            
          Case 2
              Select EventType()
                Case #PB_EventType_MouseEnter
                      StartDrawing(CanvasOutput(2))
                          Box(0,0,60,22,$FFCC99)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)
                          DrawText(4,2,"Edition",$151FFE)
                       StopDrawing()
                      DisplayPopupMenu(2,WindowID(0),WindowX(0) + GadgetX(2) + 8, WindowY(0) + 50)
                      
                Case  #PB_EventType_MouseLeave
                        StartDrawing(CanvasOutput(2))
                          Box(0,0,60,22,$808080)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)                                
                          DrawText(4,2,"Edition",$FFFFFF)
                       StopDrawing()
                      
                Case #PB_EventType_MouseMove 
                     Debug GetGadgetAttribute(2, #PB_Canvas_MouseX) 
                     Debug GetGadgetAttribute(2, #PB_Canvas_MouseY)
              EndSelect   
          
          Case 3
              Select EventType()
                Case #PB_EventType_MouseEnter
                        StartDrawing(CanvasOutput(3))
                          Box(0,0,60,22,$FFCC99)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)
                          DrawText(14,2,"Help",$151FFE)
                       StopDrawing()
                      DisplayPopupMenu(3,WindowID(0),WindowX(0) + WindowWidth(0) - 142, WindowY(0) + 50)
                      
                Case  #PB_EventType_MouseLeave
                        StartDrawing(CanvasOutput(3))
                          Box(0,0,60,22,$808080)
                          DrawingFont(FontID(0))
                          DrawingMode(#PB_2DDrawing_Transparent)                                
                          DrawText(14,2,"Help",$FFFFFF)
                       StopDrawing()
                      
                Case #PB_EventType_MouseMove 
                     Debug GetGadgetAttribute(3, #PB_Canvas_MouseX) 
                     Debug GetGadgetAttribute(3, #PB_Canvas_MouseY)
              EndSelect   
          

        EndSelect

      Case #PB_Event_CloseWindow
        Quit = 1

    EndSelect

  Until Quit = 1

EndIf

End
Edit :Code updated to solve fonts bug
Last edited by RASHAD on Sun Mar 03, 2013 6:02 pm, edited 1 time in total.
Egypt my love
Top
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Re: Custom & Stylish Menu [Windows]

Post by SFSxOI »

Very nice RASHAD, thanks :)
The advantage of a 64 bit operating system over a 32 bit operating system comes down to only being twice the headache.
Top
User avatar
Teddy Rogers
User
User
Posts: 92
Joined: Sun Feb 23, 2014 2:05 am
Location: Australia
Contact:
Contact Teddy Rogers

Re: Custom & Stylish Menu [Windows]

Post by Teddy Rogers »

I have been looking at this code by Rashad for the shell32.dll icons, modified to have the popup image menu from the tray icon instead. Unfortunately it leaks memory every time the tray icon menu appears and disappears. If you look at the "private bytes" of the process whilst it is running and open close the tray icon menu you will see this increasing every time the menu is viewed. Can anyone see what is missing please?

Code: Select all

Procedure SetImage(iMenu, iID, ico)
  ExtractIconEx_("shell32.dll", ico, 0, @iIcon, 1)
  im=CreateImage(#PB_Any, 16, 16 ,32)
  StartDrawing(ImageOutput(im))
     Box(0, 0, 16, 16, GetSysColor_(#COLOR_MENU))
     DrawingMode(#PB_2DDrawing_AllChannels)
     DrawImage(iIcon, 0, 0, 16, 16)
  StopDrawing()
  DestroyIcon_(iIcon)
  ProcedureReturn im
EndProcedure

If OpenWindow(0, 0, 0, 0, 0, "", #PB_Window_Invisible)
  If AddSysTrayIcon(0, WindowID(0), CatchImage(0, ?Icon1))
  If SysTrayIconToolTip(0, "I am a tray icon...")
    
    Repeat
    Sleep_(1)
    MyEvent = WaitWindowEvent()
    
      Select MyEvent
        Case #PB_Event_SysTray
          If EventType() = #PB_EventType_LeftClick Or #PB_EventType_RightClick
            If CreatePopupImageMenu(0)
              MenuItem(1, "About", ImageID(SetImage(GetSubMenu_(MenuID(0),0), 0, 221)))
              MenuItem(2, "Quit", ImageID(SetImage(GetSubMenu_(MenuID(0),0), 1, 219)))
              DisplayPopupMenu(0, WindowID(Ted))
            EndIf
          EndIf
        Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          MessageRequester("I am a title...", "...about some stuff...")
        Case 2
          End ExitCode
      EndSelect
      EndSelect 
    ForEver
  EndIf
EndIf
EndIf

DataSection
  Icon1:
    IncludeBinary "data\face1.ico"
EndDataSection
Ted.
Top
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Custom & Stylish Menu [Windows]

Post by Thunder93 »

CreatePopupImageMenu() block should be outside of the repeat, and just have DisplayPopupMenu() like RASHAD has.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
Top
Post Reply

Return to “Tricks 'n' Tips”