|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic.Net (Menu/Toobar/Coolbar)
|
|
 |
Título da Dica: Adicionando Icones em Menus no VB.net
|
 |
|
|
|
Postada em 31/1/2004 por messohal
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
|
|
|
|
|
