This program uses owner drawn menus. It subclasses its form and watches for the WM_DRAWITEM and WM_MEASUREITEM messages. When it receives them, it calls subroutines OnDrawMenuItem and OnMeasureItem.

Public Function NewWindowProc(ByVal hWnd As Long, ByVal msg _
    As Long, ByVal wParam As Long, lParam As Long) As Long
    Dim mM As MEASUREITEMSTRUCT
    Dim dM As DRAWITEMSTRUCT
    Select Case msg
        Case WM_DRAWITEM
            MemCopy dM, lParam, Len(dM)
            If dM.CtlType = ODT_MENU Then
                OnDrawMenuItem hWnd, dM
            End If
        Case WM_MEASUREITEM
            MemCopy mM, lParam, Len(mM)
            If mM.CtlType = ODT_MENU Then
                mM = OnMeasureItem(hWnd, mM)
                MemCopy lParam, mM, Len(mM)
            End If
    End Select
    NewWindowProc = CallWindowProc(OldWindowProc, hWnd, _
        msg, wParam, VarPtr(lParam))
End Function

Sburoutine OnDrawMenuItem draws a menu item.

Function OnMeasureItem(hWnd As Long, lpmis As _
    MEASUREITEMSTRUCT) As MEASUREITEMSTRUCT
    On Error GoTo E2
    Dim xM As MEASUREITEMSTRUCT, hfntOld As Long
    Dim S As Size, hdc As Long

    'find DC
    hdc = GetDC(hWnd)

    hfntOld = SelectObject(hdc, hFont)

    GetTextExtentPoint hdc, _
        MyItem(lpmis.itemData).szItemText, _
            MyItem(lpmis.itemData).cchItemText, S

    'set menu item rect
    xM.itemWidth = S.cx + 10
    xM.itemHeight = S.cy

    SelectObject hdc, hfntOld
    ReleaseDC hWnd, hdc

    LSet OnMeasureItem = xM
    Exit Function
E2:
    Form1.Caption = lpmis.itemData
    Exit Function
End Function

Sub OnDrawMenuItem(hWnd As Long, lpdis As DRAWITEMSTRUCT)
    On Error GoTo E1
    Dim x, y

    'set the menuitem colors
    If (lpdis.itemState And ODS_SELECTED) Then 'if selected
        clrPrevText = SetTextColor(lpdis.hdc, _
            GetSysColor(COLOR_HIGHLIGHTTEXT))
        clrPrevBkgnd = SetBkColor(lpdis.hdc, _
            GetSysColor(COLOR_HIGHLIGHT))
    Else
        clrPrevText = SetTextColor(lpdis.hdc, _
            GetSysColor(COLOR_MENUTEXT))
        clrPrevBkgnd = SetBkColor(lpdis.hdc, _
            GetSysColor(COLOR_MENU))
    End If

    'leave space for checkmark
    'may use GetMenuCheckMarkDimensions
    x = lpdis.rcItem.Left + 20
    y = lpdis.rcItem.Top

    hfntPrev = SelectObject(lpdis.hdc, hFont)

    ExtTextOut lpdis.hdc, x, y, ETO_OPAQUE, _
        lpdis.rcItem, Trim(" "), 1&, 0&

    TextOut lpdis.hdc, x, y, _
        MyItem(lpdis.itemData).szItemText, _
        MyItem(lpdis.itemData).cchItemText
    'Form1.Caption = lpdis.itemData
    'may put some bitblt function here also.

    SelectObject lpdis.hdc, hfntPrev
    SetTextColor lpdis.hdc, clrPrevText
    SetBkColor lpdis.hdc, clrPrevBkgnd
    Exit Sub
E1:
    Form1.Caption = lpdis.itemData
    Exit Sub
End Sub