在VB.NET中给菜单加上图标

80酷酷网    80kuku.com

  菜单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(60, 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 Is 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(15, 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(60, 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 you want add icon modify the property OwnerDraw to TRUE
'For use this code only 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


分享到
  • 微信分享
  • 新浪微博
  • QQ好友
  • QQ空间
点击: