Purebasic: OwnerDraw Menu with icons

 

Для нескольких проектов понадобились нестандартные меню. Вчера вечером занялся кодом, нашел пример на одном из форумов и переписал код чтобы было по фэншую.

;http://forums.purebasic.com/english/viewtopic.php?t=68668
Procedure WinProc(hWnd, Msg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select Msg
    Case #WM_MEASUREITEM:
      *lpmis.MEASUREITEMSTRUCT = lParam
      With *lpmis
        hdc=GetDC_(0)
        ;m$="no ink "+\itemData
        m$="no ink"
        SelectObject_(hdc, GetStockObject_(#DEFAULT_GUI_FONT))
        GetTextExtentPoint32_(hdc,@m$,Len(m$),si.SIZE)
        ReleaseDC_(0,hdc)
        h=si\cy
        If h<16:h=17:EndIf
        \itemWidth = si\cx+17
        ;Debug si\cx
        \itemHeight = h
      EndWith
      
    Case #WM_DRAWITEM:
      *lpdis.DRAWITEMSTRUCT = lParam
      If *lpdis\itemState & #ODS_SELECTED
        bgbrush = selectedbrush
        bgbrush=CreateSolidBrush_(GetSysColor_(#COLOR_MENUHILIGHT))
      Else
        bgbrush = CreateSolidBrush_(GetSysColor_(#COLOR_MENU))
      EndIf
      With *lpdis
        SetBkMode_(\hDC, #TRANSPARENT)
        SelectObject_(\hDC, bgbrush)
        SelectObject_(\hDC, GetStockObject_(#NULL_PEN))
        Rectangle_(\hDC, \rcItem\left, \rcItem\top-1, \rcItem\right, \rcItem\bottom+1)
        DeleteObject_(bgbrush)
        cr=0
        If \itemData&2
          cr|$0000ff
        EndIf
        If \itemData&4
          cr|$00ff00
        EndIf
        If \itemData&1
          cr|$ff0000
        EndIf
        If \itemData=8
          cr=$5f5f5f
        EndIf
        hbru=CreateSolidBrush_(cr)
        SelectObject_(\hDC,hbru)
        Rectangle_(\hDC,\rcItem\left,\rcItem\top,\rcItem\left+16,\rcItem\top+16)
        DeleteObject_(hbru)
        \rcItem\left + 17
        SelectObject_(\hDC, GetStockObject_(#DEFAULT_GUI_FONT))
        If \itemID<>8
          m$="ink "+Str(\itemData)
        Else
          m$="no ink"
        EndIf
        DrawText_(\hDC, @m$, -1, @\rcItem, 0)
      EndWith
  EndSelect
  ProcedureReturn result
EndProcedure
If OpenWindow(0, 200, 200, 220, 100, "OwnerDraw Menu")
    If CreateMenu(0, WindowID(0))
      MenuTitle("Project") 
      OpenSubMenu("color")
      For i=0 To 8
        MenuItem( i, "col "+Str(i))
      Next i
       CloseSubMenu()
      EndIf
   For i=0 To 8
    With mii.MENUITEMINFO
      \cbSize = SizeOf (MENUITEMINFO)
      \fMask = #MIIM_TYPE|#MIIM_DATA
      \fType = #MFT_OWNERDRAW
      \dwItemData = i
      ;\dwTypeData = i
      SetMenuItemInfo_(MenuID(0), i, 0, @mii)
    EndWith
  Next i
  SetWindowCallback(@WinProc())
    Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
  EndIf