Hand Made Windows Menu [Windows]

[RASHAD]

Hi all
Specially for Fangles

Code: Select all

ExamineDesktops()

#MIM_STYLE            = $00000010
#MIM_HELPID = $4
#MIM_MAXHEIGHT        = $00000001
#MIM_BACKGROUND       = $00000002
#MIM_APPLYTOSUBMENUS  = $80000000

#MNS_AUTODISMISS = $10000000
#MNS_CHECKORBMP = $4000000
#MNS_DRAGDROP = $2000000
#MNS_MODELESS = $40000000
#MNS_NOCHECK = $80000000
#MNS_NOTIFYBYPOS = $8000000

Structure MENUINFO
   cbSize.l
   fMask.l
   dwStyle.l
   cyMax.l
   hbrBack.l
   dwContextHelpID.l
   dwMenuData.l
   CompilerIf #PB_Compiler_Processor  = #PB_Processor_x64
    PB_Alignment2.b[12]
   CompilerEndIf
EndStructure

Global Run_1,Run_2,Run_3 
 
LoadFont(0,"Georgia",10,#PB_Font_Bold)

For i = 1 To 3
CreateImage(i,60,22,24,$808080)
StartDrawing(ImageOutput(i))
  ;Box(0,0,55,22,$808080)
  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))
    ;Box(0,0,55,22,$FFCC99)
    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
 
CreateImage(10,250,400)
  StartDrawing(ImageOutput(10))
   DrawingMode(#PB_2DDrawing_Gradient )
   BackColor($C6FEFC)
   FrontColor($FEEBC6)      
   LinearGradient(30, 0, 250, 100) 
   Box(0,0,250,400)
   DrawingMode(#PB_2DDrawing_Default )
   Box(0,0,18,400,$FCC15C)
StopDrawing()

hBrush = CreatePatternBrush_(ImageID(10))

Procedure AlertThread(Parameter)
  Repeat    
    Delay(25)
    x = DesktopMouseX()
    y = DesktopMouseY()
    Gad = WindowFromPoint_(x + y << 32)
    cn$=Space(#MAX_PATH)
    GetClassName_(Gad, @cn$, #MAX_PATH)
    If cn$ = "#32768"
        ActGad = Gad
    EndIf
 		If Gad = GadgetID(1) And (Run_2 = 1 Or Run_3 = 1)
		      Run_2 = 0
		      Run_3 = 0
		      SendMessage_(WindowID(0),#WM_CANCELMODE,0,0)
		ElseIf Gad = GadgetID(2) And (Run_1 = 1 Or Run_3 = 1)
		      Run_1 = 0
		      Run_3 = 0
		      SendMessage_(WindowID(0),#WM_CANCELMODE,0,0)
		ElseIf Gad = GadgetID(3) And (Run_1 = 1 Or Run_2 = 1)
		      Run_1 = 0
		      Run_2 = 0
		      SendMessage_(WindowID(0),#WM_CANCELMODE,0,0)
		ElseIf  Gad = WindowID(0) And IsWindowEnabled_(ActGad)
				  Run_1 = 0
		      Run_2 = 0
		      Run_3 = 0
          SendMessage_(WindowID(0),#WM_CANCELMODE,0,0)
    EndIf
  ForEver
EndProcedure

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

Space$ = "     "

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

     mHnd1 = CreatePopupMenu(1) 
      MenuItem( 1, Space$ + "&Load...")
      ;SetMenuItemBitmaps_(mHnd1,0,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(1),0), 0, 4)),0)
      MenuItem( 2, Space$ + "Save")
     ; SetMenuItemBitmaps_(mHnd1,1,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(1),0), 1, 130)),0)
      MenuItem( 3, Space$ + "Save As...")
      ;SetMenuItemBitmaps_(mHnd1,2,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(1),0), 2, 194)),0)
      MenuBar()
      OpenSubMenu(Space$ + "Recents")
        MenuItem( 5,Space$ +  "Pure.png")
        MenuItem( 6,Space$ +  "Basic.jpg")
        OpenSubMenu(Space$ + "Even more !")
          MenuItem( 8,Space$ +  "Yeah")
        CloseSubMenu()
        MenuItem( 9,Space$ +  "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 10,Space$ +  "&Quit")

    mHnd2 = CreatePopupMenu(2)
      MenuItem( 11,Space$ + "Cut")
      ;SetMenuItemBitmaps_(mHnd2,0,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(2),0), 0, 4)),0)
      MenuItem( 12,Space$ + "Copy")
      ;SetMenuItemBitmaps_(mHnd2,1,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(2),0), 1, 43)),0)
      MenuItem(13,Space$ + "Paste")
      ;SetMenuItemBitmaps_(mHnd2,2,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(2),0), 2, 10)),0)
      
    mHnd3 = CreatePopupMenu(3)
      MenuItem(14,Space$ + "Contents and Index")
       ;SetMenuItemBitmaps_(mHnd3,0,#MF_BYPOSITION, ImageID(SetImage(GetSubMenu_(MenuID(3),0), 3,90)),0)
      MenuItem(15,Space$ + "About")
      
m.MENUINFO
m\cbSize  = SizeOf(m)
m\fMask   = #MIM_STYLE|#MIM_BACKGROUND|#MIM_MAXHEIGHT| #MIM_APPLYTOSUBMENUS  ;#MIM_APPLYTOSUBMENUS to apply background brush to all sub menus
;m\dwStyle =  #MNS_CHECKORBMP     ;For Icon
m\dwStyle = #MNS_NOCHECK             ;No Icon
m\cyMax   = 0
m\hbrBack = hBrush

SetMenuInfo_(mHnd1,m)
SetMenuInfo_(mHnd2,m)
SetMenuInfo_(mHnd3,m)


  ContainerGadget(0,0,0,400,22)
	  CanvasGadget(1,0,0,60,22)
	  CanvasGadget(2,60,0,60,22)
	  CanvasGadget(3, 345,0,60,22)
	  CloseGadgetList()
  SetGadgetColor(0,#PB_Gadget_BackColor,$808080)
  
  For i = 1 To 3
       SetGadgetAttribute(i, #PB_Canvas_Image ,ImageID(i)) 
  Next 
  
  CreateThread(@AlertThread(), 15)

  Repeat 
    Select WaitWindowEvent()
      Case #PB_Event_SizeWindow
          ResizeGadget(0,0,0,WindowWidth(0),22)
          ResizeGadget(3,WindowWidth(0)-60,0,60,22)
          
      Case #PB_Event_Menu
        Select EventMenu()
              Case 1
                    Debug "Load"
              Case 11
                    Debug "Cut"
              Case 15
                    Debug "Help"
        EndSelect

      Case #PB_Event_Gadget
        Select EventGadget()              
          Case 1
             Select EventType()
                Case #PB_EventType_MouseEnter
                        ;Run = 1
                        Run_1 = 1
                        SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(4))                         
	                      DisplayPopupMenu(1,WindowID(0),WindowX(0) + GadgetX(1) + 8, WindowY(0) + 52)	                      
                      
                Case  #PB_EventType_MouseLeave
                        SetGadgetAttribute(1, #PB_Canvas_Image ,ImageID(1)) 
              EndSelect   
            
          Case 2
              Select EventType()
                 Case #PB_EventType_MouseEnter
                      Run_2 = 1
                      SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(5)) 
                      DisplayPopupMenu(2,WindowID(0),WindowX(0) + GadgetX(2) + 8, WindowY(0) + 52)
                      
                Case  #PB_EventType_MouseLeave
                        SetGadgetAttribute(2, #PB_Canvas_Image ,ImageID(2)) 
              EndSelect   
          
          Case 3
              Select EventType()
                Case #PB_EventType_MouseEnter
                        Run_3 = 1
                        SetGadgetAttribute(3, #PB_Canvas_Image ,ImageID(6)) 
                        DisplayPopupMenu(3,WindowID(0),WindowX(0) + WindowWidth(0) - 202, WindowY(0) + 52)
                      
                Case  #PB_EventType_MouseLeave
                        SetGadgetAttribute(3, #PB_Canvas_Image ,ImageID(3)) 
              EndSelect

        EndSelect

      Case #PB_Event_CloseWindow
        Quit = 1

    EndSelect

  Until Quit = 1
EndIf
End

[Fangbeast]

Specially for Fangles

Thanks you cheeky bugger. I nearly fell out of my chair laughing.

Now, who is taking bets that I can understand it??

hehehe.

Would be nice to have a visual ownerdrawn menu designer for normal, image and popupimage menus as I like to match all elements of a form together and I make too many mistakes the manual way due to eyesight problems.

[RASHAD]

No you will Fangles
Just take a deep breeze
In fact it is a totally owner drawn menu using CanvasGadget()

The difficult will be changing the Font

Code: Select all

Global SFColor.i, SBColor.i 

Structure new_mm 
Text.s 
EndStructure

Global Dim menu.new_mm(6),hFont
;LoadFont(0,"Ms Sans Serif",12,#PB_Font_HighQuality)
LoadFont(0,"Georgia",14,#PB_Font_Bold)
hFont = FontID(0)

Procedure Menu_Owner(hWnd, uMsg, wParam, lParam)
 
   Select uMsg 
    
    Case #WM_MEASUREITEM 
        hdc = GetDC_(hWnd) 
        *nmm.MEASUREITEMSTRUCT = lParam 
        *lnew_mm.new_mm = *nmm\itemData 
         hFontOld = SelectObject_(hDC,hFont)       
        GetTextExtentPoint32_(hdc,*lnew_mm\Text,Len(*lnew_mm\Text),@size.SIZE); 
        *nmm\itemWidth = size\cx 
        *nmm\itemHeight = size\cy
        ReleaseDC_(hWnd,hdc)
        
    Case #WM_DRAWITEM 
        *nmd.DRAWITEMSTRUCT = lParam 
        *llnew_mm.new_mm = *nmd\itemData 
        If *nmd\itemState & #ODS_SELECTED
             hFontOld = SelectObject_(*nmd\hDC,hFont) 
            SetTextColor_(*nmd\hDC,SFColor) 
            SetBkColor_(*nmd\hDC,SBColor) 
            ntx = *nmd\rcItem\left 
            nty = *nmd\rcItem\top 
            ExtTextOut_(*nmd\hDC,ntx,nty,#ETO_OPAQUE,*nmd\rcItem,*llnew_mm\Text,Len(*llnew_mm\Text),0)
        Else 
            ntx = *nmd\rcItem\left
            nty = *nmd\rcItem\top 
             hFontOld = SelectObject_(*nmd\hDC,hFont) 
            ExtTextOut_(*nmd\hDC,ntx,nty,#ETO_OPAQUE,*nmd\rcItem,*llnew_mm\Text,Len(*llnew_mm\Text),0)
        EndIf
        
  EndSelect
        ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 




If OpenWindow(0, 0, 0,400,300, "PopupMenu Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

  ListIconGadget(0, 10, 10, 280, 240, "Tools", 200)
    AddGadgetItem(0, -1, "Hammer")
    AddGadgetItem(0, -1, "Screwdriver")
    
 hMenu = CreatePopupMenu(0)
  MenuItem(1, "")
  MenuItem(2, "")
  MenuItem(3, "")
  MenuBar()
 OpenSubMenu("")
    MenuItem(4, "")
    MenuItem(5, "")
 CloseSubMenu()
  MenuBar()
  MenuItem( 6, "")
 

    ModifyMenu_(hMenu,1,#MF_BYCOMMAND|#MF_OWNERDRAW,1,menu(0)) 
    ModifyMenu_(hMenu,2,#MF_BYCOMMAND|#MF_OWNERDRAW,2,menu(1)) 
    ModifyMenu_(hMenu,3,#MF_BYCOMMAND|#MF_OWNERDRAW,3,menu(2))
    ModifyMenu_(hMenu,4,#MF_BYPOSITION|#MF_OWNERDRAW,0,menu(6))    
    ModifyMenu_(hMenu,4,#MF_BYCOMMAND|#MF_OWNERDRAW,4,menu(3))
    ModifyMenu_(hMenu,5,#MF_BYCOMMAND|#MF_OWNERDRAW,5,menu(4)) 
    ModifyMenu_(hMenu,6,#MF_BYCOMMAND|#MF_OWNERDRAW,6,menu(5))
        

    menu(0)\Text = " Cut"
    menu(1)\Text = " Copy"
    menu(2)\Text = " Paste"
    menu(3)\Text = " Window..."
    menu(4)\Text = " Gadget..."
    menu(5)\Text = " Quit"
    menu(6)\Text = " Options"
    
    SFColor = $00FFFF
    SBColor = $EAAB0D
    
    
    SetWindowCallback(@Menu_Owner()) 
  Repeat

    Select WaitWindowEvent()
        
      Case #PB_Event_Gadget
        If EventGadget() = 0 And EventType() = #PB_EventType_RightClick
          DisplayPopupMenu(0, WindowID(0))
        EndIf
          
      Case #PB_Event_Menu
      
        Select EventMenu()  ; To see which menu has been selected

          Case 1 ; Cut
            MessageRequester("PureBasic", "Cut", 0)

          Case 2 ; Copy
            MessageRequester("PureBasic", "Copy", 0)

          Case 3 ; Paste
            MessageRequester("PureBasic", "Paste", 0)

          Case 6 ; Quit
            Quit = 1

        EndSelect
        
      Case #PB_Event_CloseWindow
        Quit = 1

    EndSelect

  Until Quit = 1
EndIf 
End

[Kwai chang caine]

The two code works very well
Thanks RASHAD for sharing

[marroh]

Can be useful, thx.

[Zach]

If we could all code like Rashad we'd be freaking millionares