1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
|
Public Class HexButton
Inherits Button
'Set the styles so we can control the painting
Public Sub New()
Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or _
ControlStyles.UserPaint Or _
ControlStyles.OptimizedDoubleBuffer, True)
End Sub
'Paint the button
Protected Overrides Sub OnPaint(ByVal pevent As System.Windows.Forms.PaintEventArgs)
'First set the region
If Me.Region Is Nothing Then
setRegion()
End If
'Get the points that correspond to our hex shape
'These are the same points used to create the region
Dim hexPoints As PointF() = getHexPoints()
'Create a GraphicsPath
Using gp As GraphicsPath = getPath(hexPoints)
'Create a Pen to draw with
Using p As New Pen(Color.Red)
'Draw the background of the button
pevent.Graphics.FillPath(Brushes.Blue, gp)
'Draw the outline of the button
pevent.Graphics.DrawPolygon(p, hexPoints)
'Draw the text for the button
Dim sf As New StringFormat
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
sf.Trimming = StringTrimming.Word
Dim rc As New RectangleConverter
pevent.Graphics.DrawString(Me.Text, Me.Font, Brushes.White, Me.ClientRectangle, sf)
End Using
End Using
End Sub
'When the button is resized, it makes sure the button is a square in shape and sets the new region
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
Me.Height = Me.Width
setRegion()
End Sub
'Sets the button's region. Disposing of any existing region
Private Sub setRegion()
'Get the button's current region, if any
Dim tmpRegion As Region = Me.Region
'Set the button's new region
Me.Region = getRegion()
'Dispose of the old region
If tmpRegion IsNot Nothing Then
tmpRegion.Dispose()
End If
End Sub
'Creates a Region object from a GraphicsPath
Private Function getRegion() As Region
Dim rgn As Region = Nothing
Using gp As GraphicsPath = getPath()
rgn = New Region(gp)
End Using
Return rgn
End Function
Private Function getRegion(ByVal gp As GraphicsPath) As Region
Return New Region(gp)
End Function
'Creates a GraphicsPath object from an array of points
Private Function getPath() As GraphicsPath
Dim gp As New GraphicsPath()
gp.AddPolygon(getHexPoints())
gp.CloseFigure()
Return gp
End Function
Private Function getPath(ByVal hexPoints As PointF()) As GraphicsPath
Dim gp As New GraphicsPath
gp.AddPolygon(hexPoints)
gp.CloseFigure()
Return gp
End Function
Private Function getHexPoints() As PointF()
Me.Width = 500
Dim hexPoints As PointF() = _
{New PointF(20, 6), _
New PointF(20, 63), _
New PointF(0, 63), _
New PointF(0, 105), _
New PointF(122, 105), _
New PointF(122, 120), _
New PointF(146, 120), _
New PointF(146, 27), _
New PointF(109, 27), _
New PointF(109, 6)}
Return hexPoints
End Function
End Class |
Partager