Tuesday, May 11, 2010

Rendering ContextMenu with Images in VB.Net 2005/2008

I know there is Toolstrip and ContextMenuStrip but that do not render as per native windows UI, so I implemented this code to get images displayed in ContextMenu
Imports System.Drawing.Text
Imports System.Windows.Forms
Imports System.Drawing.Drawing2D
Imports System.ComponentModel

Module MenuImageRenderer
    Private Function GetMaxWidth(ByVal g As Graphics, ByVal _item As MenuItem) As Integer
        Dim wd As Single, sz As SizeF
        For Each itm As MenuItem In _item.Parent.MenuItems
            sz = g.MeasureString(itm.Text, SystemFonts.MenuFont)
            If wd < sz.Width Then
                wd = sz.Width
            End If
        Next
        Return Math.Ceiling(wd)
    End Function

    Sub MeasureMenuItem(ByVal e As MeasureItemEventArgs, ByVal _item As MenuItem)
        Using sf As StringFormat = New StringFormat()
            sf.HotkeyPrefix = HotkeyPrefix.Show
            sf.SetTabStops(GetMaxWidth(e.Graphics, _item), New Single() {0})
            e.ItemHeight = SystemInformation.MenuButtonSize.Height
            e.ItemWidth = CInt(e.Graphics.MeasureString(GetMenuText(_item), SystemFonts.MenuFont, 1000, sf).Width) + 5
        End Using
    End Sub

    Sub DrawMenuItem(ByVal e As DrawItemEventArgs, ByVal _item As MenuItem, ByVal m_Icon As Image)
        Dim rcTemp As Rectangle = e.Bounds

        e.Graphics.TextRenderingHint = TextRenderingHint.SystemDefault

        If CBool(e.State And DrawItemState.Selected) Then
            e.Graphics.FillRectangle(SystemBrushes.MenuHighlight, rcTemp)
        Else
            e.Graphics.FillRectangle(SystemBrushes.Menu, rcTemp)
        End If

        rcTemp = New Rectangle(e.Bounds.X + 1, e.Bounds.Y + 1, 16, 16)

        If Not m_Icon Is Nothing Then
            If Not _item.Checked Then
                e.Graphics.DrawImage(m_Icon, rcTemp)
            Else
                e.Graphics.DrawImage(m_Icon, rcTemp)
                Dim nPen As System.Drawing.Pen
                If Not _item.Enabled Then
                    nPen = New Pen(Color.DarkGray)
                Else
                    nPen = New Pen(Color.Gray)
                End If
                e.Graphics.DrawRectangle(nPen, rcTemp)
            End If
        Else
            If _item.Checked Then
                Dim Pnts() As Point
                ReDim Pnts(2)
                Pnts(0) = New Point(15, e.Bounds.Top + 6)
                Pnts(1) = New Point(8, e.Bounds.Top + 13)
                Pnts(2) = New Point(5, e.Bounds.Top + 10)
                If _item.Enabled Then
                    e.Graphics.DrawRectangle(SystemPens.ActiveBorder, 1, e.Bounds.Top, 16, 16)
                    e.Graphics.DrawLines(SystemPens.MenuText, Pnts)
                Else
                    e.Graphics.DrawRectangle(SystemPens.GrayText, 1, e.Bounds.Top, 16, 16)
                    e.Graphics.DrawLines(SystemPens.GrayText, Pnts)
                End If
            End If
        End If
        Using sf As StringFormat = New StringFormat
            sf.HotkeyPrefix = HotkeyPrefix.Show
            sf.SetTabStops(GetMaxWidth(e.Graphics, _item), New Single() {0})
            sf.LineAlignment = StringAlignment.Center
            Dim rc As Rectangle = e.Bounds
            rc.X = rc.Left + 17

            If _item.Enabled Then
                e.Graphics.DrawString(GetMenuText(_item), SystemFonts.MenuFont, SystemBrushes.MenuText, rc, sf)
            Else
                e.Graphics.DrawString(GetMenuText(_item), SystemFonts.MenuFont, SystemBrushes.GrayText, rc, sf)
            End If
        End Using
    End Sub

    Function GetMenuText(ByVal _item As MenuItem) As String
        Dim _itemText As String = _item.Text
        If _item.ShowShortcut And _item.Shortcut <> Shortcut.None Then
            Dim k As Keys = CType(_item.Shortcut, Keys)
            _itemText = _itemText & Convert.ToChar(9) & _
   TypeDescriptor.GetConverter(GetType(Keys)).ConvertToString(k)
        End If
        Return _itemText
    End Function
End Module