Imports System.Drawing.Drawing2D
Public Class Digit
Implements IDisposable
Public Event LocationChanged As EventHandler
Public Event HeightChanged As EventHandler
Public Event ElementsWidthChanged As EventHandler
Public Event ValueChanged As EventHandler
Public Event ElementsGapChanged As EventHandler
Public Event ColorChanged As EventHandler
Public Event VisibleChanged As EventHandler
Private WithEvents _owner As Control
Private _location As Point
Private _height As Single
Private _elementsWidth As Single
Private _value As Integer
Private _elementsGap As Single
Private _color As Color
Private _id As String
Private _top As New GraphicsPath
Private _topRight As New GraphicsPath
Private _topLeft As New GraphicsPath
Private _middle As New GraphicsPath
Private _bottomRight As New GraphicsPath
Private _bottomLeft As New GraphicsPath
Private _bottom As New GraphicsPath
Private _bounds As Rectangle
Private _brush As Brush
Private _visible As Boolean
#Region " Properties "
Public Property Visible() As Boolean
Get
Return Me._visible
End Get
Set(ByVal value As Boolean)
If Me._visible <> value Then
Me._visible = value
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(Me._bounds)
Me._owner.Update()
End If
Me.OnVisibleChanged(New EventArgs)
End If
End Set
End Property
Public Property Location() As Point
Get
Return Me._location
End Get
Set(ByVal value As Point)
If Me._location <> value Then
Me._location = value
Me.UpdatePaths()
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(False)
Me._owner.Update()
End If
Me.OnLocationChanged(New EventArgs)
End If
End Set
End Property
Public Property [Color]() As Color
Get
Return Me._color
End Get
Set(ByVal value As Color)
If Me._color <> value Then
Me._color = value
Me._brush.Dispose()
Me._brush = New SolidBrush(value)
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(Me._bounds)
Me._owner.Update()
End If
Me.OnColorChanged(New EventArgs)
End If
End Set
End Property
Public ReadOnly Property [Brush]() As Brush
Get
Return Me._brush
End Get
End Property
Public Property Height() As Single
Get
Return Me._height
End Get
Set(ByVal value As Single)
If Me._height <> value Then
Me._height = value
Me.UpdatePaths()
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(False)
Me._owner.Update()
End If
Me.OnHeightChanged(New EventArgs)
End If
End Set
End Property
Public Property ElementsWidth() As Single
Get
Return Me._elementsWidth
End Get
Set(ByVal value As Single)
If Me._elementsWidth <> value Then
Me._elementsWidth = value
Me.UpdatePaths()
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(False)
Me._owner.Update()
End If
Me.OnElementsWidthChanged(New EventArgs)
End If
End Set
End Property
Public Property ElementsGap() As Single
Get
Return Me._elementsGap
End Get
Set(ByVal value As Single)
If Me._elementsGap <> value Then
Me._elementsGap = value
Me.UpdatePaths()
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(False)
Me._owner.Update()
End If
Me.OnElementsGapChanged(New EventArgs)
End If
End Set
End Property
Public Property Value() As Integer
Get
Return Me._value
End Get
Set(ByVal value As Integer)
If Me._value <> value Then
If value >= 0 AndAlso value <= 9 Then
Me._value = value
If Me._owner IsNot Nothing Then
Me._owner.Invalidate(Me._bounds)
Me._owner.Update()
End If
Me.OnValueChanged(New EventArgs)
Else
Throw New ArgumentOutOfRangeException("value", value, "The value must be in the range 0 to 9")
End If
End If
End Set
End Property
Public ReadOnly Property Bounds() As Rectangle
Get
Return Me._bounds
End Get
End Property
Public ReadOnly Property Id() As String
Get
Return Me._id
End Get
End Property
#End Region
#Region " Methods "
Sub New(ByVal owner As Control, ByVal id As String)
Me.New(owner, id, Color.Lime, New Point(0, 0), 20, 4, 1, True)
End Sub
Sub New(ByVal owner As Control, ByVal id As String, ByVal col As Color, ByVal location As Point, ByVal height As Single, ByVal elementsWidth As Single, ByVal elementsGap As Single)
Me.New(owner, id, col, location, height, elementsWidth, elementsGap, True)
End Sub
Sub New(ByVal owner As Control, ByVal id As String, ByVal col As Color, ByVal location As Point, ByVal height As Single, ByVal elementsWidth As Single, ByVal elementsGap As Single, ByVal visible As Boolean)
Me._owner = owner
Me._id = id
Me._color = col
Me._location = location
Me._height = height
Me._elementsWidth = elementsWidth
Me._elementsGap = elementsGap
Me._brush = New SolidBrush(col)
Me._visible = visible
Me.UpdatePaths()
End Sub
Private Sub UpdatePaths()
Me.SetTop()
Me.SetTopRight()
Me.SetTopLeft()
Me.SetMiddle()
Me.SetBottomRight()
Me.SetBottomLeft()
Me.SetBottom()
Me._bounds = New Rectangle(Me._location.X, Me._location.Y, _
CInt(Me._topRight.PathPoints(3).X - Me._location.X + 1), _
CInt(Me._height) + 1)
End Sub
Private Sub SetTop()
Me._top.Reset()
Dim points(5) As PointF
Dim halfWidth As Single = Me._elementsWidth / 2
Dim longSide As Single = (Me._height - 3 * Me._elementsWidth) / 2 - 2 * Me._elementsGap
points(0) = New PointF(Me._location.X + Me._elementsWidth + Me._elementsGap, Me._location.Y)
points(1) = New PointF(points(0).X + longSide, Me._location.Y)
points(2) = New PointF(points(1).X + halfWidth, CSng(Me._location.Y + halfWidth))
points(3) = New PointF(points(1).X, points(1).Y + Me._elementsWidth)
points(4) = New PointF(points(0).X, points(0).Y + Me._elementsWidth)
points(5) = New PointF(Me._location.X + halfWidth + Me._elementsGap, points(2).Y)
Me._top.AddLines(points)
End Sub
Private Sub SetTopRight()
Me._topRight.Reset()
Me._topRight.AddPath(Me._top, False)
Dim p As PointF = Me._top.PathPoints(2)
Dim mx As New Matrix
mx.RotateAt(-90, p)
mx.Translate(-Me._elementsGap, Me._elementsGap)
Me._topRight.Transform(mx)
mx.Dispose()
End Sub
Private Sub SetTopLeft()
Me._topLeft.Reset()
Me._topLeft.AddPath(Me._top, False)
Dim p As PointF = Me._top.PathPoints(5)
Dim mx As New Matrix
mx.RotateAt(90, p)
mx.Translate(Me._elementsGap, Me._elementsGap)
Me._topLeft.Transform(mx)
mx.Dispose()
End Sub
Private Sub SetMiddle()
Me._middle.Reset()
Me._middle.AddPath(Me._top, False)
Dim mx As New Matrix
mx.Translate(0, (Me._height - Me._elementsWidth) / 2)
Me._middle.Transform(mx)
mx.Dispose()
End Sub
Private Sub SetBottomLeft()
Me._bottomLeft.Reset()
Me._bottomLeft.AddPath(Me._topLeft, False)
Dim y As Single = Me._topLeft.PathPoints(2).Y - Me._topLeft.PathPoints(5).Y
Dim mx As New Matrix
mx.Translate(0, y + 2 * Me._elementsGap)
Me._bottomLeft.Transform(mx)
mx.Dispose()
End Sub
Private Sub SetBottomRight()
Me._bottomRight.Reset()
Me._bottomRight.AddPath(Me._topRight, False)
Dim y As Single = Me._topRight.PathPoints(5).Y - Me._topRight.PathPoints(2).Y
Dim mx As New Matrix
mx.Translate(0, y + 2 * Me._elementsGap)
Me._bottomRight.Transform(mx)
mx.Dispose()
End Sub
Private Sub SetBottom()
Me._bottom.Reset()
Me._bottom.AddPath(Me._top, False)
Dim mx As New Matrix
mx.Translate(0, Me._height - Me._elementsWidth)
Me._bottom.Transform(mx)
mx.Dispose()
End Sub
#Region " OnEvent "
Protected Overridable Sub OnLocationChanged(ByVal e As EventArgs)
RaiseEvent LocationChanged(Me, e)
End Sub
Protected Overridable Sub OnHeightChanged(ByVal e As EventArgs)
RaiseEvent HeightChanged(Me, e)
End Sub
Protected Overridable Sub OnElementsWidthChanged(ByVal e As EventArgs)
RaiseEvent ElementsWidthChanged(Me, e)
End Sub
Protected Overridable Sub OnValueChanged(ByVal e As EventArgs)
RaiseEvent ValueChanged(Me, e)
End Sub
Protected Overridable Sub OnElementsGapChanged(ByVal e As EventArgs)
RaiseEvent ElementsGapChanged(Me, e)
End Sub
Protected Overridable Sub OnColorChanged(ByVal e As EventArgs)
RaiseEvent ColorChanged(Me, e)
End Sub
Protected Overridable Sub OnVisibleChanged(ByVal e As EventArgs)
RaiseEvent VisibleChanged(Me, e)
End Sub
#End Region
#End Region
#Region " Events "
Private Sub _owner_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles _owner.Paint
If Me._visible Then
Select Case Me._value
Case 0
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottomLeft)
e.Graphics.FillPath(Me._brush, Me._bottom)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._topLeft)
Case 1
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
Case 2
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._middle)
e.Graphics.FillPath(Me._brush, Me._bottomLeft)
e.Graphics.FillPath(Me._brush, Me._bottom)
Case 3
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._middle)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._bottom)
Case 4
e.Graphics.FillPath(Me._brush, Me._topLeft)
e.Graphics.FillPath(Me._brush, Me._middle)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
Case 5
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topLeft)
e.Graphics.FillPath(Me._brush, Me._middle)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._bottom)
Case 6
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topLeft)
e.Graphics.FillPath(Me._brush, Me._bottomLeft)
e.Graphics.FillPath(Me._brush, Me._bottom)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._middle)
Case 7
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
Case 8
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottomLeft)
e.Graphics.FillPath(Me._brush, Me._bottom)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._topLeft)
e.Graphics.FillPath(Me._brush, Me._middle)
Case 9
e.Graphics.FillPath(Me._brush, Me._top)
e.Graphics.FillPath(Me._brush, Me._topRight)
e.Graphics.FillPath(Me._brush, Me._bottom)
e.Graphics.FillPath(Me._brush, Me._bottomRight)
e.Graphics.FillPath(Me._brush, Me._topLeft)
e.Graphics.FillPath(Me._brush, Me._middle)
End Select
End If
End Sub
#End Region
#Region " IDisposable Support "
Private disposedValue As Boolean ' To detect redundant calls
' IDisposable
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
' TODO: free other state (managed objects).
Me._top.Dispose()
Me._topRight.Dispose()
Me._topLeft.Dispose()
Me._middle.Dispose()
Me._bottomRight.Dispose()
Me._bottomLeft.Dispose()
Me._bottom.Dispose()
Me._brush.Dispose()
End If
' TODO: free your own state (unmanaged objects).
' TODO: set large fields to null.
End If
Me.disposedValue = True
End Sub
' This code added by Visual Basic to correctly implement the disposable pattern.
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
Submit an article or tip