Un simple TypeConverter junto a un UITypeEditor (opcional) para representar un color en formato web.



Nota: los colores no se ven como deberían por la compresión de imagen del software que he usado para capturar el GIF animado xD

WebColorConverter.vb

#Region " Option Statements "
 
Option Strict On
Option Explicit On
Option Infer Off
 
#End Region
 
#Region " Imports "
 
Imports System.ComponentModel
Imports System.Globalization
 
#End Region
 
Public Class WebColorConverter : Inherits ColorConverter
 
    <DebuggerStepThrough>
    Public Overrides Function GetStandardValuesSupported(context As ITypeDescriptorContext) As Boolean
 
        Return True
    End Function
 
    <DebuggerStepThrough>
    Public Overrides Function GetStandardValues(context As ITypeDescriptorContext) As StandardValuesCollection
 
        Dim collection As New Collection()
 
        For Each kc As KnownColor In [Enum].GetValues(GetType(KnownColor))
            Dim color As Color = Color.FromKnownColor(kc)
 
            If Not color.IsSystemColor AndAlso color.IsNamedColor Then
                collection.Add(color)
            End If
        Next
 
        Return New StandardValuesCollection(collection)
    End Function
 
    <DebuggerStepThrough>
    Public Overrides Function ConvertTo(context As ITypeDescriptorContext,
                                    culture As CultureInfo,
                                    value As Object,
                                    destinationType As Type) As Object
 
        If destinationType Is GetType(String) AndAlso TypeOf value Is Color Then
            Dim color As Color = DirectCast(value, Color)
            Dim html As String = If(color.A <> 255, $"#{color.A:X2}{color.R:X2}{color.G:X2}{color.B:X2}",
                                    ColorTranslator.ToHtml(Color.FromArgb(color.R, color.G, color.B)))
 
            Dim name As String = Nothing
            For Each knownColor As KnownColor In [Enum].GetValues(GetType(KnownColor))
                Dim k As Color = Color.FromKnownColor(knownColor)
                If k.A = color.A AndAlso
                   k.R = color.R AndAlso
                   k.G = color.G AndAlso
                   k.B = color.B AndAlso Not k.IsSystemColor Then
 
                    name = k.Name
                    Exit For
                End If
            Next
 
            Return If(name IsNot Nothing, $"{html} ({name})", html)
        End If
 
        Return MyBase.ConvertTo(context, culture, value, destinationType)
    End Function
 
    <DebuggerStepThrough>
    Public Overrides Function ConvertFrom(context As ITypeDescriptorContext,
                                          culture As CultureInfo,
                                          value As Object) As Object
 
        Dim s As String = TryCast(value, String)
        If s IsNot Nothing Then
            s = s.Trim()
 
            ' If input is like "xxx (Name)" remove the part in parentheses
            Dim idx As Integer = s.IndexOf("("c)
            If idx >= 0 Then
                s = s.Substring(0, idx).Trim()
            End If
 
            If s.StartsWith("#") Then
                Dim hx As String = s.Substring(1).Trim()
 
                ' Support #RRGGBB and #AARRGGBB
                If hx.Length = 6 Then
                    Dim r As Integer = Convert.ToInt32(hx.Substring(0, 2), 16)
                    Dim g As Integer = Convert.ToInt32(hx.Substring(2, 2), 16)
                    Dim b As Integer = Convert.ToInt32(hx.Substring(4, 2), 16)
                    Return Color.FromArgb(255, r, g, b)
 
                ElseIf hx.Length = 8 Then
                    Dim a As Integer = Convert.ToInt32(hx.Substring(0, 2), 16)
                    Dim r As Integer = Convert.ToInt32(hx.Substring(2, 2), 16)
                    Dim g As Integer = Convert.ToInt32(hx.Substring(4, 2), 16)
                    Dim b As Integer = Convert.ToInt32(hx.Substring(6, 2), 16)
                    Return Color.FromArgb(a, r, g, b)
 
                Else
                    ' Support short hex format (#RGB) by expanding to 6 digits
                    If hx.Length = 3 Then
                        Dim r As Integer = Convert.ToInt32(String.Concat(hx(0), hx(0)), 16)
                        Dim g As Integer = Convert.ToInt32(String.Concat(hx(1), hx(1)), 16)
                        Dim b As Integer = Convert.ToInt32(String.Concat(hx(2), hx(2)), 16)
                        Return Color.FromArgb(255, r, g, b)
                    End If
                End If
 
            Else
                ' Try ColorTranslator for standard names and "Transparent"
                Try
                    Dim c As Color = ColorTranslator.FromHtml(s)
                    ' ColorTranslator.FromHtml returns A=255 for known names; A=0 for "Transparent"
                    Return c
 
                Catch ex As Exception
                    ' Try KnownColor enum (e.g. user types "White" or "WhiteSmoke")
                    Try
                        Dim kc As KnownColor
                        If [Enum].TryParse(s, True, kc) Then
                            Return Color.FromKnownColor(kc)
                        End If
                    Catch
                        ' Continue to fallback
                    End Try
                End Try
            End If
 
            ' If everything fails, fallback to the base converter (throws or defaults)
        End If
 
        Return MyBase.ConvertFrom(context, culture, value)
    End Function
 
End Class
 

WebColorEditor.vb

#Region " Option Statements "
 
Option Strict On
Option Explicit On
Option Infer Off
 
#End Region
 
#Region " Imports "
 
Imports System.ComponentModel
Imports System.Drawing.Design
 
#End Region
 
Public Class WebColorEditor : Inherits UITypeEditor
 
    <DebuggerStepThrough>
    Public Overrides Function GetEditStyle(context As ITypeDescriptorContext) As UITypeEditorEditStyle
 
        Return UITypeEditorEditStyle.None
    End Function
 
    <DebuggerStepThrough>
    Public Overrides Function GetPaintValueSupported(context As ITypeDescriptorContext) As Boolean
 
        Return True
    End Function
 
    <DebuggerStepThrough>
    Public Overrides Sub PaintValue(e As PaintValueEventArgs)
 
        Dim color As Color
 
        If TypeOf e.Value Is Color Then
            color = DirectCast(e.Value, Color)
        Else
            Exit Sub
        End If
 
        Using brush As New SolidBrush(color)
            e.Graphics.FillRectangle(brush, e.Bounds)
        End Using
    End Sub
 
End Class

Modo de empleo:

Imports System.ComponentModel
Imports System.Drawing.Design
 
Public Class Form1
 
    Private ReadOnly ClassTest As New MyClassTest
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
 
        Me.PropertyGrid1.SelectedObject = Me.ClassTest
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
 
        Me.ClassTest.MyColor = Color.FromArgb(255, 116, 222, 4)
        Me.PropertyGrid1.Refresh()
    End Sub
End Class
 
Friend NotInheritable Class MyClassTest
 
    <TypeConverter(GetType(WebColorConverter))>
    <Editor(GetType(WebColorEditor), GetType(UITypeEditor))> ' El editor es opcional.
    Public Property MyColor As Color = Color.Transparent
 
End Class

Ejemplo de utilidad en la vida real: un programa open-source para mostrar en tiempo real el color del pixel actual en la pantalla (entre otras cosas):

Una forma universal y personalizable para reportar progreso en nuestro icono del área de notificación (system tray)...

Importante: recomiendo no usar más de dos caracteres para el texto. Con tres caracteres ya se achica mucho, y con más, se vuelve prácticamente imposible de leer. Hay muy poco espacio legible para un icono de 32x32px.

                   

NotifyIconProgressBar.vb

Public Structure NotifyIconProgressBar
 
    Public Height As Integer
    Public BackColor As Color
    Public ForeColor As Color
    Public FillColor As Color
    Public BorderColor As Color
    Public BorderWidth As Integer
 
    Public Shared ReadOnly Property Empty As NotifyIconProgressBar
        Get
            Return New NotifyIconProgressBar With {
                .Height = 0,
                .BackColor = Color.Empty,
                .ForeColor = Color.Empty,
                .FillColor = Color.Empty,
                .BorderColor = Color.Empty,
                .BorderWidth = 0
            }
        End Get
    End Property
 
End Structure

P/invokes:

<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function DestroyIcon(hIcon As IntPtr) As Boolean
End Function

El método principal:

Imports System.Drawing.Drawing2D
Imports System.Drawing.Text
Imports System.Runtime.InteropServices
 
''' <summary>
''' Renders a progress bar overlay on a <see cref="NotifyIcon"/> and optionally draws text on it.
''' </summary>
''' 
''' <param name="ntfy">
''' The <see cref="NotifyIcon"/> whose icon will be updated with the rendered progress bar.
''' </param>
''' 
''' <param name="progressBar">
''' A <see cref="NotifyIconProgressBar"/> structure containing the bar's height, colors and border width.
''' </param>
''' 
''' <param name="value">
''' The current position of the progress bar.
''' </param>
''' 
''' <param name="maximumValue">
''' The maximum <paramref name="value"/> range of the progress bar.
''' </param>
''' 
''' <param name="text">
''' Optional text to display centered above the progress bar.
''' Must be 3 characters or fewer if provided.
''' </param>
<DebuggerStepThrough>
Public Shared Sub RenderNotifyIconProgressBar(ntfy As NotifyIcon, baseIcon As Icon, progressBar As NotifyIconProgressBar,
                                              value As Integer, maximumValue As Integer,
                                              Optional text As String = Nothing)
 
    If ntfy Is Nothing Then
        Throw New ArgumentNullException(NameOf(ntfy))
    End If
 
    If baseIcon Is Nothing Then
        Throw New ArgumentNullException(NameOf(baseIcon))
    End If
 
    If maximumValue <= 0 Then
        Throw New ArgumentOutOfRangeException(NameOf(maximumValue), $"{NameOf(maximumValue)} must be greater than zero.")
    End If
 
    If value < 0 OrElse (value > maximumValue) Then
        Throw New ArgumentOutOfRangeException(NameOf(value), $"{NameOf(value)} must be between zero and {NameOf(maximumValue)}.")
    End If
 
    Dim currentIcon As Icon = ntfy.Icon
 
    Using bmp As Bitmap = baseIcon.ToBitmap()
 
        Dim width As Integer = bmp.Width
        Dim height As Integer = bmp.Height
 
        If progressBar.Height <= 0 Then
            Throw New ArgumentOutOfRangeException(NameOf(progressBar.Height), $"{NameOf(progressBar.Height)} must be greater than zero.")
        End If
 
        If progressBar.Height > height Then
            Throw New ArgumentOutOfRangeException(NameOf(progressBar.Height), $"{NameOf(progressBar.Height)} ({progressBar.Height}) exceeds the icon height ({height}).")
        End If
 
        If progressBar.BorderWidth > height Then
            Throw New ArgumentOutOfRangeException(NameOf(progressBar.BorderWidth), $"{NameOf(progressBar.BorderWidth)} ({progressBar.BorderWidth}) exceeds the icon height ({height}).")
        End If
 
        Using g As Graphics = Graphics.FromImage(bmp)
            g.CompositingMode = CompositingMode.SourceOver
            g.CompositingQuality = CompositingQuality.HighQuality
            g.InterpolationMode = InterpolationMode.High
            g.PixelOffsetMode = PixelOffsetMode.Half
            g.SmoothingMode = SmoothingMode.AntiAlias
            g.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
 
            Dim barY As Integer = height - progressBar.Height
 
            Using backgroundBrush As New SolidBrush(progressBar.BackColor)
                g.FillRectangle(backgroundBrush, 0, barY, width, progressBar.Height)
            End Using
 
            Using fillBrush As New SolidBrush(progressBar.FillColor)
                Dim percent As Single = CSng(value / maximumValue)
                Dim filledWidth As Integer = CInt(width * percent)
                g.FillRectangle(fillBrush, 0, barY, filledWidth, progressBar.Height)
            End Using
 
            If progressBar.BorderWidth > 0 Then
                Using borderPen As New Pen(progressBar.BorderColor, progressBar.BorderWidth)
                    g.DrawRectangle(borderPen, 0, barY, width - 1, progressBar.Height)
                End Using
            End If
 
            If Not String.IsNullOrWhiteSpace(text) Then
 
                Using fontFamily As New FontFamily("Segoe UI")
                    Dim fontStyle As FontStyle = FontStyle.Bold
 
                    Dim layoutRect As New RectangleF(0, 0, width, height)
                    Dim fontSizePx As Single = ComputeMaxFontSizeForRectangle(g, text, fontFamily, fontStyle, layoutRect)
 
                    Using font As New Font(fontFamily, fontSizePx, fontStyle, GraphicsUnit.Pixel)
 
                        Using gp As New GraphicsPath()
                            Dim sf As New StringFormat() With {
                                .Alignment = StringAlignment.Center,
                                .LineAlignment = StringAlignment.Center
                            }
                            gp.AddString(text, font.FontFamily, font.Style, font.Size, layoutRect, sf)
 
                            ' Outline then fill for best legibility
                            Using outlinePen As New Pen(Color.FromArgb(220, Color.Black), Math.Max(1.0F, fontSizePx * 0.18F))
                                outlinePen.LineJoin = LineJoin.Round
                                g.DrawPath(outlinePen, gp)
                            End Using
 
                            Using foregroundBrush As New SolidBrush(progressBar.ForeColor)
                                g.FillPath(foregroundBrush, gp)
                            End Using
                        End Using
                    End Using
                End Using
            End If
        End Using
 
        Dim hIcon As IntPtr = bmp.GetHicon()
        Using tempIcon As Icon = Icon.FromHandle(hIcon)
            Dim finalIcon As Icon = CType(tempIcon.Clone(), Icon)
            DestroyIcon(hIcon)
            ntfy.Icon = finalIcon
        End Using
 
        currentIcon.Dispose()
    End Using
End Sub

Función auxiliar necesaria:

''' <summary>
''' Determines the largest font size that allows the specified text to fit entirely 
''' within the given rectangle when drawn using the provided <see cref="Graphics"/> object.
''' </summary>
''' 
''' <param name="g">
''' The source <see cref="Graphics"/> object used to measure the text.
''' </param>
''' 
''' <param name="text">
''' The text to measure.
''' </param>
''' 
''' <param name="fontFamily">
''' The font family to use (e.g., "Segoe UI").
''' </param>
''' 
''' <param name="fontStyle">
''' The font style (e.g., <see cref="FontStyle.Regular"/>).
''' </param>
''' 
''' <param name="layoutRectangle">
''' The rectangle within which the text must fit.
''' </param>
''' 
''' <param name="minimumSize">
''' The minimum allowed font size (in <see cref="GraphicsUnit.Pixel"/>).
''' <para></para>
''' If the text does not fit even at this size, the function returns this value.
''' <para></para>
''' Default value is <c>1.0</c>.
''' </param>
''' 
''' <param name="tolerance">
''' The precision threshold for how closely the function tries to fit the text in the rectangle, in <see cref="GraphicsUnit.Pixel"/>.
''' <para></para>
''' Smaller values gives more exact results but will require more time to compute.
''' <para></para>
''' Default value is <c>0.5</c>.
''' </param>
''' 
''' <returns>
''' The largest font size in <see cref="GraphicsUnit.Pixel"/> that fits the text inside the rectangle.
''' <para></para>
''' If the text cannot fit even at <paramref name="minimumSize"/>, that minimum value is returned.
''' </returns>
Public Shared Function ComputeMaxFontSizeForRectangle(g As Graphics, text As String,
                                                      fontFamily As FontFamily, fontStyle As FontStyle,
                                                      layoutRectangle As RectangleF,
                                                      Optional minimumSize As Single = 1.0F,
                                                      Optional tolerance As Single = 0.5F) As Single
 
    Dim minSize As Single = minimumSize
    Dim maxSize As Single = layoutRectangle.Height
    Dim bestFit As Single = minSize
 
    While (maxSize - minSize) > tolerance
        Dim midSize As Single = (minSize + maxSize) / 2
 
        Using testFont As New Font(fontFamily, midSize, fontStyle, GraphicsUnit.Pixel)
            Dim textSize As SizeF = g.MeasureString(text, testFont)
 
            If (textSize.Width <= layoutRectangle.Width) AndAlso
               (textSize.Height <= layoutRectangle.Height) Then
                bestFit = midSize
                minSize = midSize
            Else
                maxSize = midSize
            End If
        End Using
    End While
 
    Return Math.Max(minimumSize, bestFit)
End Function

Ejemplo de uso:

Private Async Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
 
    Dim progressBar As New NotifyIconProgressBar With {
        .Height = 32,
        .BackColor = Color.Transparent,
        .ForeColor = Color.White,
        .FillColor = Color.LimeGreen
    }
 
    Dim ntfy As NotifyIcon = Me.NotifyIcon1
    Dim baseIcon As Icon = DirectCast(ntfy.Icon.Clone(), Icon)
 
    Dim maxValue As Integer = 100
    For i As Integer = 0 To maxValue
        RenderNotifyIconProgressBar(ntfy, baseIcon, progressBar, i, maxValue, CStr(i))
        Await Task.Delay(100)
    Next
End Sub