glowing label

'GlowLabel by Kudi

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class GlowLabel
    Inherits Label

    Private _glowColor As Color = Color.White

    Public Overridable Property GlowColor() As Color
        Get
            Return _glowColor
        End Get
        Set(ByVal value As Color)
            _glowColor = value
            Me.Invalidate()
        End Set
    End Property

    Protected Overrides Sub OnPaintBackground(ByVal pevent As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaintBackground(pevent)

        Using b As New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height)
            Using g As Graphics = Graphics.FromImage(b)
                Dim e As New PaintEventArgs(g, pevent.ClipRectangle)

                Me.OnPaint(e)
            End Using

            BlurImage(b)

            pevent.Graphics.DrawImageUnscaled(b, 0, 0)
        End Using
    End Sub

    <StructLayout(LayoutKind.Explicit)>
    Private Structure ColorArgb
        <FieldOffset(0)> Public Value As Integer
        <FieldOffset(3)> Public A As Byte
        <FieldOffset(2)> Public R As Byte
        <FieldOffset(1)> Public G As Byte
        <FieldOffset(0)> Public B As Byte
    End Structure

    Private Sub BlurImage(ByVal b As Bitmap)
        Const Radius As Integer = 1

        Dim bd As BitmapData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
        Dim arr(bd.Width * bd.Height - 1) As Integer
        Dim arr2(arr.Length - 1) As Integer
        Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
        Marshal.Copy(bd.Scan0, arr2, 0, arr2.Length)

        Dim vals(8) As ColorArgb
        Dim val As ColorArgb
        val.R = Me.GlowColor.R
        val.G = Me.GlowColor.G
        val.B = Me.GlowColor.B

        For i As Integer = 1 To Radius
            For x As Integer = 1 To bd.Width - 2
                For y As Integer = 1 To bd.Height - 2
                    For dX As Integer = -1 To 1
                        For dY As Integer = -1 To 1
                            vals(dY * 3 + dX + 4).Value = arr2((y + dY) * bd.Width + x + dX)
                        Next
                    Next

                    val.A = CByte((From z As ColorArgb In vals Select CInt(z.A)).Sum() \ 9)

                    arr(y * bd.Width + x) = val.Value
                Next
            Next
            If i < Radius Then arr2 = DirectCast(arr.Clone(), Integer())
        Next

        Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
        b.UnlockBits(bd)
    End Sub
End Class

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class GlowLabel
    Inherits Label

    Private _glowColor As Color = Color.White

    Public Overridable Property GlowColor() As Color
        Get
            Return _glowColor
        End Get
        Set(ByVal value As Color)
            _glowColor = value
            Me.Invalidate()
        End Set
    End Property

    Protected Overrides Sub OnPaintBackground(ByVal pevent As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaintBackground(pevent)

        Using b As New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height)
            Using g As Graphics = Graphics.FromImage(b)
                Dim e As New PaintEventArgs(g, pevent.ClipRectangle)

                Me.OnPaint(e)
            End Using

            BlurImage(b)

            pevent.Graphics.DrawImageUnscaled(b, 0, 0)
        End Using
    End Sub

    <StructLayout(LayoutKind.Explicit)>
    Private Structure ColorArgb
        <FieldOffset(0)> Public Value As Integer
        <FieldOffset(3)> Public A As Byte
        <FieldOffset(2)> Public R As Byte
        <FieldOffset(1)> Public G As Byte
        <FieldOffset(0)> Public B As Byte
    End Structure

    Private Sub BlurImage(ByVal b As Bitmap)
        Const Radius As Integer = 1

        Dim bd As BitmapData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
        Dim arr(bd.Width * bd.Height - 1) As Integer
        Dim arr2(arr.Length - 1) As Integer
        Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
        Marshal.Copy(bd.Scan0, arr2, 0, arr2.Length)

        Dim vals(8) As ColorArgb
        Dim val As ColorArgb
        val.R = Me.GlowColor.R
        val.G = Me.GlowColor.G
        val.B = Me.GlowColor.B

        For i As Integer = 1 To Radius
            For x As Integer = 1 To bd.Width - 2
                For y As Integer = 1 To bd.Height - 2
                    For dX As Integer = -1 To 1
                        For dY As Integer = -1 To 1
                            vals(dY * 3 + dX + 4).Value = arr2((y + dY) * bd.Width + x + dX)
                        Next
                    Next

                    val.A = CByte((From z As ColorArgb In vals Select CInt(z.A)).Sum() \ 9)

                    arr(y * bd.Width + x) = val.Value
                Next
            Next
            If i < Radius Then arr2 = DirectCast(arr.Clone(), Integer())
        Next

        Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
        b.UnlockBits(bd)
    End Sub
End Class