在 VB.NET 中向菜单添加图标

• 下载源代码 - 7.8 KB

引言

这个项目在 VB.NET 菜单中添加图标。你可以使用模块 'IconsMenuMain.vb' 作为项目的基准来添加图标。这比 VB 6 或其他语言更容易。

'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

在 VC#.NET 中编写起来也很容易。

许可证

本文未附加明确的许可证，但可能在文章文本或下载文件本身中包含使用条款。如有疑问，请通过下面的讨论区联系作者。

作者可能使用的许可证列表可以在此处找到。