VB.NET: How to Make an Oval, Triangle, Pentagon, Hexagon, or Octagon for a Control or a Form
This document was originally published as an MSDN discussion here on September 3rd, 2009
and has been reproduced here.
This will allow you all to suggest any changes, however small.
__________________________________________________________________
Saw a post earlier which reminded me about Extension Methods.
This led to creating the following code which acts on the base class CONTROL for ALL controls!!
So??!! You might ask what does it do?
Well using just one line of code you can transform any of your controls
into the shape you want within the bounds of the original shape of the control.
So if you have a square control like a square button or picturebox, you will get a regular shape.
If the dotted rectangle ( that the control is drawn out within ) is wider than it is tall
or vice-versa than the regular shape is stretched to fit this shape.
Best explained with an example.
From the PROJECT menu using VB.Net 2008 or a later version select ADD MODULE , type in ShapedControls.Vb in the NAME box and click on OK.
Then PASTE this code in.
Option Strict On
Imports System.Runtime.CompilerServices
Module ShapedControls
Public Const Pi As Double = Math.PI
Public Const DegreesToRadians As Double = 180 / Pi
<Extension()> _
Public Sub Shape(ByVal ctrl As Control, _
Optional ByVal NumberOfSides As Integer = 3, _
Optional ByVal OffsetAngleInDegrees As Double = 0)
If NumberOfSides < 3 Then Throw New Exception("Number of sides can only be 3 or more.")
Dim MyAngle As Double = OffsetAngleInDegrees / DegreesToRadians
Dim radius1 As Integer = ctrl.Height \ 2
Dim radius2 As Integer = ctrl.Width \ 2
Dim xInt, yInt As Integer
Dim xDoub, yDoub As Double
Dim MyPath As New Drawing2D.GraphicsPath
For angle As Double = MyAngle To ((2 * Pi) + MyAngle) Step ((2 * Pi) / NumberOfSides)
xDoub = radius2 * Math.Cos(angle) + radius2
yDoub = radius1 * Math.Sin(angle) + radius1
xInt = CInt(Int(xDoub))
yInt = CInt(Int(yDoub))
MyPath.AddLine(New Point(xInt, yInt), New Point(xInt, yInt))
Next
MyPath.CloseFigure()
ctrl.Region = New Region(MyPath)
MyPath.Dispose()
End Sub
End Module
Have you done that? Good.
Now paste this in as your FORM code and run it.
Option Strict On
Public Class Form1
Dim P1, P2 As New PictureBox
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load
Me.WindowState = FormWindowState.Maximized
P1.Size = New Size(300, 300)
P1.Location = New Point(20, 20)
P1.BackColor = Color.LightBlue
P1.Shape(4)
Me.Controls.Add(P1)
P2.Size = New Size(300, 300)
P2.Location = New Point(350, 20)
P2.BackColor = Color.Yellow
P2.Shape(8, 0)
Me.Controls.Add(P2)
Dim Btn1 As New Button
Btn1.Location = New Point(Me.Width \ 2, Me.Height \ 2)
Btn1.Size = New Size(300, 150)
Btn1.TextAlign = ContentAlignment.MiddleCenter
Btn1.Text = "Hi!!"
Btn1.Font = New Font("Arial", 30, FontStyle.Underline)
Btn1.BackColor = Color.Black
Btn1.ForeColor = Color.White
Btn1.Shape(6, 30)
AddHandler Btn1.Click, AddressOf Btn1Click
Me.Controls.Add(Btn1)
End Sub
Private Sub Btn1Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
MessageBox.Show("Hi there!!")
Dim ofd As New OpenFileDialog
ofd.Filter = "Picture files|*.jpg;*.bmp;*.png"
ofd.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyPictures
Dim result As DialogResult = ofd.ShowDialog
P1.BackgroundImageLayout = ImageLayout.Zoom
If result = Windows.Forms.DialogResult.OK Then
P1.BackgroundImage = Image.FromFile(ofd.FileName)
End If
End Sub
End Class
The SHAPE extension for all controls takes two optional parameters or arguments.
E.g:
Button1.Shape(6,0)
means 6 sides with an offset angle of zero degrees.
Enjoy!!
Oh, and the start point appears to be the right hand point on a circle as if the 0 degrees is EAST on a compass.
Please bear this in mind.
As the parameters are OPTIONAL you could say.
Button1.Shape()
or
Button1.Shape(6, 30)
or
Button1.Shape(, 30)
as it defaults to 3 sides ( the minimum ).
<edit on 14th July, 2010> With a version of the code below this post the minimum is now 2 sides.
If the containing area is square you end up with a circle, otherwise you will get a pointed oval. </edit>
The above example creates two shaped PictureBoxes and a stretched hexagon shaped button!!
Like this where the first two shapes are PictureBoxes and the hexagon is a Button.
http://i13.photobucket.com/albums/a272/u-might-want-this/ShapedControls.jpg
_______________________________________________________________________________________________________________________________________________________________
Around September 7th, 2009 we tweaked the code to allow for two-sided shapes.>>
Have added to the original code so you can now have controls in the shape of a pointed oval.
For now this can only be horizontal or vertical.
If the control size is square such as 300 X 300 then the control ends up as a circle shape.
Here is the updated module code.
Option Strict On
Imports System.Runtime.CompilerServices
Module ShapedControls
Public Const Pi As Double = Math.PI
Public Const DegreesToRadians As Double = 180 / Pi
<Extension()> _
Public Sub Shape(ByVal ctrl As Control, _
Optional ByVal NumberOfSides As Integer = 3, Optional ByVal OffsetAngleInDegrees As Double = 0)
If NumberOfSides < 2 Then Throw New Exception("Number of sides can only be 2 or more.")
Dim MyPath As New Drawing2D.GraphicsPath
Dim MyAngle As Double = OffsetAngleInDegrees / DegreesToRadians
If NumberOfSides = 2 Then
Dim MyPoints() As Point
Dim MyPointsList As New List(Of Point)
If ctrl.Width = ctrl.Height Then
MyPath.AddEllipse(New Rectangle(0, 0, ctrl.Width, ctrl.Height))
ElseIf ctrl.Width > ctrl.Height Then
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
ElseIf ctrl.Width < ctrl.Height Then
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
End If
End If
Dim radius1 As Integer = ctrl.Height \ 2
Dim radius2 As Integer = ctrl.Width \ 2
Dim xInt, yInt As Integer
Dim xDoub, yDoub As Double
For angle As Double = MyAngle To ((2 * Pi) + MyAngle) Step ((2 * Pi) / NumberOfSides)
xDoub = radius2 * Math.Cos(angle) + radius2
yDoub = radius1 * Math.Sin(angle) + radius1
xInt = CInt(Int(xDoub))
yInt = CInt(Int(yDoub))
MyPath.AddLine(New Point(xInt, yInt), New Point(xInt, yInt))
Next
MyPath.CloseFigure()
ctrl.Region = New Region(MyPath)
MyPath.Dispose()
End Sub
End Module
Here is some FORM code which demonstrates it and a screenshot.
Option Strict On
Public Class Form1
Dim P1, P2 As New PictureBox
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.WindowState = FormWindowState.Maximized
P1.Size = New Size(300, 300)
P1.Location = New Point(20, 20)
P1.BackColor = Color.LightBlue
P1.Shape(4)
Me.Controls.Add(P1)
P2.Size = New Size(300, 300)
P2.Location = New Point(350, 20)
P2.BackColor = Color.Yellow
P2.Shape(8, 0)
Me.Controls.Add(P2)
Dim Btn1 As New Button
Btn1.Location = New Point(Me.Width \ 4, Me.Height \ 2)
Btn1.Size = New Size(300, 200)
Btn1.TextAlign = ContentAlignment.MiddleCenter
Btn1.Text = "Hi!!"
Btn1.Font = New Font("Arial", 30, FontStyle.Underline)
Btn1.BackColor = Color.Black
Btn1.ForeColor = Color.White
Btn1.Shape(2)
AddHandler Btn1.Click, AddressOf Btn1Click
Me.Controls.Add(Btn1)
End Sub
Private Sub Btn1Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
MessageBox.Show("Hi there!!")
Dim ofd As New OpenFileDialog
ofd.Filter = "Picture files|*.jpg;*.bmp;*.png"
ofd.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyPictures
Dim result As DialogResult = ofd.ShowDialog
P1.BackgroundImageLayout = ImageLayout.Zoom
If result = Windows.Forms.DialogResult.OK Then
P1.BackgroundImage = Image.FromFile(ofd.FileName)
End If
End Sub
End Class
http://i13.photobucket.com/albums/a272/u-might-want-this/ShapedControls2.jpg
The blacked pointed oval above is a button the other shapes are Pictureboxes
_____________________________________________________________________________________________________________________________________
Around September 10th, 2009 we made a further addition.
Have added even more code so you can make any control
like a button into one of eight triangle shapes as below.
E.G: The buttons in the first picture turn into those in the second picture. :-) ;-) >>
http://i13.photobucket.com/albums/a272/u-might-want-this/TriangularControls.jpg
Here is the very short FORM code.
Option Strict On
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Button1.MakeTriangular(TriangleDirection.Up)
Button2.MakeTriangular(TriangleDirection.Down)
Button3.MakeTriangular(TriangleDirection.Left)
Button4.MakeTriangular(TriangleDirection.Right)
Button5.MakeTriangular(TriangleDirection.TopRight)
Button6.MakeTriangular(TriangleDirection.TopLeft)
Button7.MakeTriangular(TriangleDirection.BottomRight)
Button8.MakeTriangular(TriangleDirection.BottomLeft)
End Sub
End Class
Here is the updated MODULE code.
Option Strict On
Imports System.Runtime.CompilerServices
Module ShapedControls
Public Const Pi As Double = Math.PI
Public Const DegreesToRadians As Double = 180 / Pi
Public Enum TriangleDirection
Up
Right
Down
Left
TopRight
BottomRight
BottomLeft
TopLeft
End Enum
<Extension()> _
Public Sub Shape(ByVal ctrl As Control, _
Optional ByVal NumberOfSides As Integer = 3, Optional ByVal OffsetAngleInDegrees As Double = 0)
If NumberOfSides < 2 Then Throw New Exception("Number of sides can only be 2 or more.")
Dim MyPath As New Drawing2D.GraphicsPath
Dim MyAngle As Double = OffsetAngleInDegrees / DegreesToRadians
If NumberOfSides = 2 Then
Dim MyPoints() As Point
Dim MyPointsList As New List(Of Point)
If ctrl.Width = ctrl.Height Then
MyPath.AddEllipse(New Rectangle(0, 0, ctrl.Width, ctrl.Height))
ElseIf ctrl.Width > ctrl.Height Then
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
ElseIf ctrl.Width < ctrl.Height Then
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPointsList.Add(New Point(ctrl.Width, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
MyPointsList.Add(New Point(ctrl.Width \ 2, ctrl.Height))
MyPointsList.Add(New Point(0, ctrl.Height \ 2))
MyPointsList.Add(New Point(ctrl.Width \ 2, 0))
MyPoints = MyPointsList.ToArray
MyPath.AddCurve(MyPoints)
MyPointsList.Clear()
End If
End If
Dim radius1 As Integer = ctrl.Height \ 2
Dim radius2 As Integer = ctrl.Width \ 2
Dim xInt, yInt As Integer
Dim xDoub, yDoub As Double
For angle As Double = MyAngle To ((2 * Pi) + MyAngle) Step ((2 * Pi) / NumberOfSides)
xDoub = radius2 * Math.Cos(angle) + radius2
yDoub = radius1 * Math.Sin(angle) + radius1
xInt = CInt(Int(xDoub))
yInt = CInt(Int(yDoub))
MyPath.AddLine(New Point(xInt, yInt), New Point(xInt, yInt))
Next
MyPath.CloseFigure()
ctrl.Region = New Region(MyPath)
MyPath.Dispose()
End Sub
<Extension()> _
Public Sub MakeTriangular(ByVal ctrl As Control, ByVal Triangle_Direction As TriangleDirection)
Dim MyPath As New Drawing2D.GraphicsPath
Select Case Triangle_Direction
Case Is = TriangleDirection.Up
MyPath.AddLine(0, ctrl.Height, 0, ctrl.Height)
MyPath.AddLine(0, ctrl.Height, ctrl.Width \ 2, 0)
MyPath.AddLine(ctrl.Width \ 2, 0, ctrl.Width, ctrl.Height)
Case TriangleDirection.Right
MyPath.AddLine(0, ctrl.Height, 0, 0)
MyPath.AddLine(0, 0, ctrl.Width, ctrl.Height \ 2)
Case TriangleDirection.Down
MyPath.AddLine(0, 0, ctrl.Width, 0)
MyPath.AddLine(ctrl.Width, 0, ctrl.Width \ 2, ctrl.Height)
Case TriangleDirection.Left
MyPath.AddLine(ctrl.Width, 0, ctrl.Width, ctrl.Height)
MyPath.AddLine(ctrl.Width, ctrl.Height, 0, ctrl.Height \ 2)
Case TriangleDirection.TopRight
MyPath.AddLine(0, 0, ctrl.Width, 0)
MyPath.AddLine(ctrl.Width, 0, ctrl.Width, ctrl.Height)
Case TriangleDirection.TopLeft
MyPath.AddLine(0, 0, ctrl.Width, 0)
MyPath.AddLine(ctrl.Width, 0, 0, ctrl.Height)
Case TriangleDirection.BottomRight
MyPath.AddLine(ctrl.Width, 0, ctrl.Width, ctrl.Height)
MyPath.AddLine(ctrl.Width, ctrl.Height, 0, ctrl.Height)
Case TriangleDirection.BottomLeft
MyPath.AddLine(0, 0, ctrl.Width, ctrl.Height)
MyPath.AddLine(ctrl.Width, ctrl.Height, 0, ctrl.Height)
End Select
MyPath.CloseFigure()
ctrl.Region = New Region(MyPath)
End Sub
End Module
____________________________________________________________________________________________________
Hope you all have as much fun using this code as when writing it.
For star shapes and other stuff please see this thread