Add an icon to the menu in vb.net

Menu adding icons to menus in vb.net

' Iconsmenumain.vb
' Module for adding icons to menus ...

Imports System
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Text
Imports System.Windows.Forms


Module Iconsmenumain

Dim M_font as New Font ("Arial", 8)

Sub Measureitems (ByVal Evmeasureitem as System.Windows.Forms.MeasureItemEventArgs, _
ByVal Mi as MenuItem)
Dim SF as StringFormat = New StringFormat ()
sf. Hotkeyprefix = Hotkeyprefix.show
sf. SetTabStops (New single () {0})
Evmeasureitem.itemheight = 22
Evmeasureitem.itemwidth = CInt (EvMeasureItem.Graphics.MeasureString (Getrealtext Mi), _
M_font, 10000, SF). Width) + 10
sf. Dispose ()
SF = Nothing
End Sub

Sub Drawitems (ByVal evdrawitems as System.Windows.Forms.DrawItemEventArgs, _
ByVal Mi as MenuItem, ByVal M_icon as Icon)
Dim BR as Brush
Dim Fdisposebrush as Boolean
If not M_icon are nothing Then
If not mi.checked Then
EvDrawItems.Graphics.DrawIcon (M_icon, EvDrawItems.Bounds.Left + 2, _
EvDrawItems.Bounds.Top + 2)
Else
EvDrawItems.Graphics.DrawIcon (M_icon, EvDrawItems.Bounds.Left + 2, _
EvDrawItems.Bounds.Top + 2)
Dim Npen as System.Drawing.Pen
If not mi.enabled Then
Npen = New Pen (color.darkgray)
Else
Npen = New Pen (color.gray)
End If
EvDrawItems.Graphics.DrawRectangle (Npen, 1, EvDrawItems.Bounds.Top, 20, 20)
EvDrawItems.Graphics.DrawRectangle (Npen, 3, EvDrawItems.Bounds.Top + 2,
16, 16)
End If
Else
If mi.checked Then
Dim Npen as System.Drawing.Pen
If not mi.enabled Then
Npen = New Pen (color.darkgray)
Else
Npen = New Pen (color.gray)
End If
EvDrawItems.Graphics.DrawRectangle (Npen, 1, EvDrawItems.Bounds.Top, 20, 20)
Dim pnts () as Point
ReDim PNTs (2)
PNTs (0) = New Point (EvDrawItems.Bounds.Top + 6)
PNTs (1) = New Point (8, EvDrawItems.Bounds.Top + 13)
PNTs (2) = New point (5, EvDrawItems.Bounds.Top + 10)
If mi.enabled Then
EvDrawItems.Graphics.DrawLines (New Pen (color.black), pnts)
Else
EvDrawItems.Graphics.DrawLines (New Pen (Color.gray), pnts)
End If
End If
End If
Dim RCBK as Rectangle = Evdrawitems.bounds
Rcbk.x + 24

If CBool (Evdrawitems.state and drawitemstate.selected) Then
br = New LinearGradientBrush (RCBK, Color.midnightblue, Color.lightblue, 0)
Fdisposebrush = True
Else
BR = Systembrushes.control
End If

EvDrawItems.Graphics.FillRectangle (BR, RCBK)
If Fdisposebrush Then Br. Dispose ()
br = Nothing

Dim SF as StringFormat = New StringFormat ()
sf. Hotkeyprefix = Hotkeyprefix.show
sf. SetTabStops (New single () {0})
If mi.enabled Then
br = New SolidBrush (evdrawitems.forecolor)
Else
br = New SolidBrush (color.gray)
End If

EvDrawItems.Graphics.DrawString (Getrealtext Mi), M_font, BR, _
EvDrawItems.Bounds.Left + 25, _
EvDrawItems.Bounds.Top + 2, SF)
Br. Dispose ()
br = Nothing
sf. Dispose ()
SF = Nothing
End Sub

Function Getrealtext (ByVal Mi as MenuItem) as String
Dim s as String = Mi.text
If mi.showshortcut and Mi.shortcut <> shortcut.none Then
Dim k as Keys = CType (mi.shortcut, keys)
s = S & Convert.tochar (9) & _
Typedescriptor.getconverter (GetType (Keys)). ConvertToString (k)
End If
return s
End Function

End Module


'**************
' In the ' items of menu which your want add icon modify the property OwnerDraw to TRUE
' For use ', this code, add the next references in the form ...

Private Sub Menuitem3_drawitem (ByVal sender as Object, _
ByVal e as System.Windows.Forms.DrawItemEventArgs) _
Handles Menuitem3.drawitem

Dim Ic as New Icon ("C:\Documents and Settings\yo\escritorio\iconmenu\save.ico")
Drawitems (E, MenuItem3, nothing)
End Sub

Private Sub Menuitem3_measureitem (ByVal sender as Object, _
ByVal e as System.Windows.Forms.MeasureItemEventArgs) _
Handles Menuitem3.measureitem

Measureitems (E, MenuItem3)
End Sub