PureBasic Forums - English

Code: Select all

    ;...Portions of this code are based on code by Andreas
    ;...which can be found at PureBasic CodeArchiv website
    Structure myMenuItem
      hFont.l
      text$
    EndStructure

    Structure myMENUBARINFO
      cbSize.l
      rcBar.RECT
      hMenu.l
      hwndMenu.l
      fBarFocused.w
      fFocused.w
    EndStructure

    ;...Array of Menu item info
    Global Dim menuItems.myMenuItem(2, 3)

    Procedure myWindowCallback(hwnd, msg, wParam, lParam)
      Shared menuParent$
      result = #PB_ProcessPureBasicEvents
      Select msg
        Case #WM_MEASUREITEM
          ;...Measure menu items here
          *pMIS.MEASUREITEMSTRUCT = lParam
          *pMenuItem.myMenuItem = *pMIS\itemData
          StartDrawing(WindowOutput(0))
          DrawingFont(*pMenuItem\hFont)
          *pMIS\itemWidth = TextWidth(*pMenuItem\text$)
          *pMIS\itemHeight = TextHeight(*pMenuItem\text$)
          StopDrawing()
          ProcedureReturn  #True
        Case #WM_DRAWITEM
          ;...Draw our menu items here
          If wParam = 0
            *dis.DRAWITEMSTRUCT = lParam
            *pMenuItem.myMenuItem = *dis\itemData
            hOldFont = SelectObject_(*dis\hdc, *pMenuItem\hFont)
            If *dis\CtlType = #ODT_MENU
              If *dis\itemState & #ODS_SELECTED
                SetTextColor_(*dis\hdc,#Red)
              Else
                SetTextColor_(*dis\hdc, #Black)
              EndIf
              DrawTextEx_(*dis\hdc, *pMenuItem\text$, Len(*pMenuItem\text$),  *dis\rcItem, #DT_LEFT | #DT_NOCLIP, 0)
              SelectObject_(*dis\hdc, hOldFont)
            EndIf
          EndIf
          ProcedureReturn  #True
      EndSelect
      ProcedureReturn result
    EndProcedure
    If OpenWindow(0, 10, 10, 300, 200, "OwnerDraw Menu", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
      SetWindowCallback(@myWindowCallback())
      hMenu = CreateMenu(0, WindowID(0))
      MenuTitle("&File")
      MenuItem(1, "&Open")
      MenuItem(2, "&Save")
      MenuItem(3, "E&xit")
      MenuTitle("&Edit")
      MenuItem(4, "&Cut")
      MenuItem(5, "C&opy")
      MenuItem(6, "&Paste")
     
      ;...Load our Menu font(s)
      MenuTitleFont = LoadFont(0, "Comic Sans MS", 10)
      MenuItemFont = LoadFont(1, "Courier New", 16)
     
      ;...Fill our array data
      ;...Menu Title "File"
      menuItems(0, 0)\text$ = GetMenuTitleText(0, 0)
      menuItems(0, 0)\hFont = MenuTitleFont
      ;...Subitems of File
      menuItems(0, 1)\text$ = GetMenuItemText(0, 1)
      menuItems(0, 1)\hFont = MenuItemFont
     
      menuItems(0, 2)\text$ = GetMenuItemText(0, 2)
      menuItems(0, 2)\hFont = MenuItemFont
     
      menuItems(0, 3)\text$ = GetMenuItemText(0, 3)
      menuItems(0, 3)\hFont = MenuItemFont
     
      ;...Menu Title "Edit"
      menuItems(1, 0)\text$ = GetMenuTitleText(0, 1)
      menuItems(1, 0)\hFont = MenuTitleFont
      ;...Subitems of Edit
      menuItems(1, 1)\text$ = GetMenuItemText(0, 4)
      menuItems(1, 1)\hFont = MenuItemFont
     
      menuItems(1, 2)\text$ = GetMenuItemText(0, 5)
      menuItems(1, 2)\hFont = MenuItemFont
     
      menuItems(1, 3)\text$ = GetMenuItemText(0, 6)
      menuItems(1, 3)\hFont = MenuItemFont
     
      ;...Here we set ownerdraw for Menu Titles "File" and "Edit"
      For i = 0 To 1
        ModifyMenu_(hMenu, i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(i ,0))
      Next i
     
      ;...Here we set ownerdraw for submenu items of Menu Title "File"
      For i = 0 To 2
        ModifyMenu_(GetSubMenu_(hMenu, 0), i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(0, i + 1))
      Next i
     
      For i = 0 To 2
        ;...Here we set ownerdraw for submenu items of Menu Title "Edit"
        ModifyMenu_(GetSubMenu_(hMenu, 1), i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(1, i + 1))
      Next i
     
      ;...Show the menu changes
      DrawMenuBar_(WindowID(0))
     
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow 
    EndIf
    End