PureBasic Forums - English

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

Custom & Stylish Menu [Windows]

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

Page 1 of 1

Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 2:27 pm
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

Re: Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 3:19 pm
by Zebuddi123
Thank RASHAD for sharing very nice great addition


Zebuddi. :D

Re: Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 3:35 pm
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...

Re: Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 5:36 pm
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.

Re: Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 5:42 pm
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

Re: Custom & Stylish Menu [Windows]

Posted: Sun Mar 03, 2013 5:55 pm
by SFSxOI
Very nice RASHAD, thanks :)

Re: Custom & Stylish Menu [Windows]

Posted: Mon Mar 10, 2014 3:56 pm
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.

Re: Custom & Stylish Menu [Windows]

Posted: Tue Mar 11, 2014 3:33 am
by Thunder93
CreatePopupImageMenu() block should be outside of the repeat, and just have DisplayPopupMenu() like RASHAD has.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited