Click here to Skip to main content
15,885,985 members
Articles / Multimedia / GDI+

gGlowBox - Create a Glow or Shadow Effect Around a Focused Control (VB.NET)

Rate me:
Please Sign up or sign in to vote.
4.89/5 (50 votes)
28 Feb 2019CPOL6 min read 113.7K   7.6K   68  
A custom Panel that creates a glow effect around a child control or a drop shadow when it receives focus
#Region "Imports"
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Reflection
Imports System.Windows.Forms
#End Region

''' <summary>
''' Panel Control to add Glow Effect to all of the Child Controls
''' </summary>
''' <remarks>v1.0.4</remarks>
<DebuggerStepThrough()>
<ProvideProperty("UseEffect", GetType(Control))>
<ProvideProperty("GlowColor", GetType(Control))>
<ProvideProperty("sGlowColor", GetType(Control))>
<ProvideProperty("EffectType", GetType(Control))>
<ToolboxItem(True), ToolboxBitmap(GetType(gGlowBox), "gControlLib.gGlowGroupBox.bmp")>
Public Class gGlowGroupBox
    Inherits Panel
    Implements IExtenderProvider

#Region "Initialize"
    Private glowProps As New Hashtable
    Public Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)

        glowProps = New Hashtable()
    End Sub
#End Region

#Region "Fields"
    Private _glowDefaultColor As Color = Color.MediumBlue
    Private _glowOn As Boolean = True
    Private _EffectTypeDefault As eEffectType = eEffectType.Glow

#End Region

#Region "ProvideProperty"

    Private Class GlowProperties
        Public UseEffect As Boolean
        Public GlowColor As Color
        Public EffectType As eEffectType

        Public Sub New(GlowColorDef As Color, EffectTypeDef As eEffectType)
            UseEffect = True
            GlowColor = GlowColorDef
            EffectType = EffectTypeDef
        End Sub
    End Class

    Private Function EnsurePropertiesExists(key As Object) As GlowProperties
        Dim p As GlowProperties = CType(glowProps(key), GlowProperties)

        If p Is Nothing Then
            p = New GlowProperties(GlowColorDefault, EffectTypeDefault)

            glowProps(key) = p
        End If

        Return p
    End Function

    <DefaultValue(True)>
    <Category("GlowBox")>
    <DisplayName("Use Effect")>
    <Description("Set if this Control creates a Focus Glow")>
    Public Function GetUseEffect(g As Control) As Boolean
        Return EnsurePropertiesExists(g).UseEffect
    End Function

    Public Sub SetUseEffect(g As Control, value As Boolean)
        EnsurePropertiesExists(g).UseEffect = value
        g.Invalidate()
    End Sub

    <DefaultValue(True)>
    <Category("GlowBox")>
    <DisplayName("Effect Type")>
    <Description("Set if this Control uses Glow or Shadow")>
    Public Function GetEffectType(g As Control) As eEffectType
        Return EnsurePropertiesExists(g).EffectType
    End Function

    Public Sub SetEffectType(g As Control, value As eEffectType)
        EnsurePropertiesExists(g).EffectType = value
        g.Invalidate()
    End Sub

    <DefaultValue(GetType(Color), "MediumBlue")>
    <Category("GlowBox")>
    <DisplayName("Glow Color")>
    <Description("Set The Color this Control will Glow when Focused")>
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
    Public Function GetGlowColor(g As Control) As Color
        Return EnsurePropertiesExists(g).GlowColor
    End Function

    Public Sub SetGlowColor(g As Control, value As Color)
        EnsurePropertiesExists(g).GlowColor = value
        g.Invalidate()
    End Sub

    <Browsable(False)>
    Public Function GetsGlowColor(g As Control) As SerialColor
        Return New SerialColor(EnsurePropertiesExists(g).GlowColor)
    End Function

    Public Sub SetsGlowColor(g As Control, value As SerialColor)
        EnsurePropertiesExists(g).GlowColor = value.DeserializeColor()
        g.Invalidate()
    End Sub

    ''' <summary>
    ''' Serializable properties for a Color
    ''' </summary>
    ''' <remarks></remarks>
    <Serializable()>
    Public Class SerialColor
        Public Name As String
        Public A As Integer
        Public R As Integer
        Public G As Integer
        Public B As Integer

        Public Sub New(ByVal color As Color)
            Name = color.Name
            A = color.A
            R = color.R
            G = color.G
            B = color.B
        End Sub

        Public Function DeserializeColor() As Color
            If Color.FromName(Name).IsKnownColor Then
                Return Color.FromName(Name)
            Else
                Return Color.FromArgb(A, R, G, B)
            End If
        End Function
    End Class

    Public Function CanExtend(extendee As Object) As Boolean Implements IExtenderProvider.CanExtend

        If (TypeOf extendee Is Control AndAlso CType(extendee, Control).Parent Is Me) Then

            If GetControlStyle(CType(extendee, Control), ControlStyles.ContainerControl) = False AndAlso
               GetControlStyle(CType(extendee, Control), ControlStyles.Selectable) = True Then
                Return True
            End If

            If TypeOf extendee Is ContainerControl Then Return False

        End If

        Return False

    End Function

    Public Shared Function GetControlStyle(control As Control, flags As ControlStyles) As Boolean
        Dim type As Type = control.[GetType]()
        Dim bindingFlgs As BindingFlags = BindingFlags.NonPublic Or BindingFlags.Instance
        Dim method As MethodInfo = type.GetMethod("GetStyle", bindingFlgs)
        Dim param As Object() = {flags}
        Return CBool(method.Invoke(control, param))
    End Function

#End Region

#Region "Properties"

    ''' <summary>
    ''' Get or Set the Default color of the Glow
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <Category("gGlowBox")>
    <Description("Get or Set the color of the Glow")>
    <DefaultValue(GetType(Color), "MediumBlue")>
    Public Property GlowColorDefault As Color
        Get
            Return _glowDefaultColor
        End Get
        Set(ByVal Value As Color)
            _glowDefaultColor = Value
            Invalidate()
        End Set
    End Property


    ''' <summary>
    ''' Turn the Glow effect on or off
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <Category("gGlowBox")>
    <Description("Turn the Glow effect on or off")>
    <DefaultValue(False)>
    Public Property GlowOn As Boolean
        Get
            Return _glowOn
        End Get
        Set(ByVal Value As Boolean)
            _glowOn = Value
            Invalidate()
        End Set
    End Property

    Public Enum eEffectType
        Glow
        Shadow
    End Enum


    ''' <summary>
    ''' Choose Glow or Shadow
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <Category("gGlowBox")>
    <Description("Choose Glow or Shadow")>
    <DefaultValue(GetType(eEffectType), "Glow")>
    Public Property EffectTypeDefault As eEffectType
        Get
            Return _EffectTypeDefault
        End Get
        Set(ByVal Value As eEffectType)
            _EffectTypeDefault = Value
            Invalidate()
        End Set
    End Property

#End Region

#Region "Paint"

    Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
        MyBase.OnPaintBackground(e)
        e.Graphics.SmoothingMode = SmoothingMode.AntiAlias

        If DesignMode = True AndAlso Controls.Count = 0 Then
            TextRenderer.DrawText(e.Graphics,
                                  String.Format("Drop controls{0}on the gGlowGroupBox", vbNewLine),
                                  New Font("Arial", 8, FontStyle.Bold),
                                  New Point(20, 20),
                                  Color.DarkBlue)
            TextRenderer.DrawText(e.Graphics,
                                 "SSDiver2112",
                                 New Font("Arial", 7, FontStyle.Bold),
                                 New Point(Width - 75, Height - 17),
                                 Color.LightGray)
        ElseIf _glowOn Then

            For Each _control As Control In Me.Controls
                Dim currProps = EnsurePropertiesExists(_control)
                If _control.Focused = True AndAlso currProps.UseEffect Then

                    Dim GlowK As Boolean = True

                    'Check if the control has the ReadOnly property and if so, its value.
                    Dim propInfo As Reflection.PropertyInfo = _control.GetType().GetProperty("ReadOnly")
                    If propInfo IsNot Nothing Then
                        GlowK = Not DirectCast(propInfo.GetValue(_control, Nothing), Boolean)
                    End If

                    If GlowK Then
                        Dim gColor As Color = currProps.GlowColor
                        If currProps.EffectType = eEffectType.Glow Then

                            Using gp As New GraphicsPath
                                'Change these to Properties if you want Design Control of the Values 
                                Dim _Glow = 15
                                Dim _Feather = 50
                                'Get a Rectangle a little smaller than the control's
                                'and make a GraphicsPath with it
                                Dim rect As Rectangle = New Rectangle(
                                                        _control.Bounds.X,
                                                        _control.Bounds.Y,
                                                        _control.Bounds.Width - 1,
                                                        _control.Bounds.Height - 1)
                                rect.Inflate(-1, -1)
                                gp.AddRectangle(rect)

                                'Draw multiple rectangles with increasing thickness and transparency
                                For i As Integer = 1 To _Glow Step 2
                                    Dim aGlow As Integer = CInt(_Feather -
                                      ((_Feather / _Glow) * i))
                                    Using pen As Pen =
                                        New Pen(Color.FromArgb(aGlow, gColor), i) With
                                        {.LineJoin = LineJoin.Round}

                                        e.Graphics.DrawPath(pen, gp)

                                    End Using

                                Next i

                            End Using

                        Else
                            Using shadowpath As New GraphicsPath
                                'Change these to Properties if you want Design Control of the Values 
                                Dim _ShadowOffset As New Point(3, 3)
                                Dim _ShadowColor As Color = gColor
                                Dim _ShadowBlur As Integer = 2
                                Dim _ShadowFeather As Integer = 100

                                Dim rect As Rectangle = New Rectangle(
                                                           _control.Bounds.X + 4 + _ShadowOffset.X,
                                                           _control.Bounds.Y + 4 + _ShadowOffset.Y,
                                                           _control.Bounds.Width - 8,
                                                           _control.Bounds.Height - 8)
                                shadowpath.AddRectangle(rect)

                                Dim x As Integer = 6
                                For i As Integer = 1 To x
                                    Using pen As Pen = New Pen(Color.FromArgb(
                                                               CInt(_ShadowFeather - ((_ShadowFeather / x) * i)), _ShadowColor),
                                                               CSng(i * (_ShadowBlur)))
                                        pen.LineJoin = LineJoin.Round
                                        e.Graphics.DrawPath(pen, shadowpath)
                                    End Using
                                Next i

                                e.Graphics.FillPath(New SolidBrush(_ShadowColor), shadowpath)
                            End Using
                        End If


                    End If
                End If
            Next

        End If

    End Sub
#End Region

#Region "Control Focus Event"

    Private Sub gGlowBox_ControlAdded(ByVal sender As Object, ByVal e As ControlEventArgs) Handles Me.ControlAdded
        ' Add handlers to let the gGlowBox know when the child control gets Focus 
        AddHandler e.Control.GotFocus, AddressOf ChildGotFocus
        AddHandler e.Control.LostFocus, AddressOf ChildLostFocus
    End Sub

    Private Sub ChildGotFocus(sender As Object, e As EventArgs)
        Invalidate()
    End Sub

    Private Sub ChildLostFocus(sender As Object, e As EventArgs)
        Invalidate()
    End Sub

    Private Sub gGlowGroupBox_ControlRemoved(sender As Object, e As ControlEventArgs) Handles Me.ControlRemoved
        RemoveHandler e.Control.GotFocus, AddressOf ChildGotFocus
        RemoveHandler e.Control.LostFocus, AddressOf ChildLostFocus
    End Sub

#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer
United States United States
I first got hooked on programing with the TI994A. After it finally lost all support I reluctantly moved to the Apple IIe. Thank You BeagleBros for getting me through. I wrote programs for my Scuba buisness during this time. Currently I am a Database manager and software developer. I started with VBA and VB6 and now having fun with VB.NET/WPF/C#...

Comments and Discussions