Transparent Label in VB

I've noticed in QA that people seem to be wondering how to create a transparent label. I normally point them to this article, that contains a very useful transparent label control in C#:

• SimpleLine line and box graphics controls[^]

Of course, it's easy to compile the C# control into a DLL and reference it from your VB project, but in other cases, you might not want to have to include an extra DLL. So I converted the code to VB for my own sake.

But due to a recent request in QA, I thought I'd post it once and for all as T&T here.

If you find it useful, great, if not - don't use it.

Just to clarify: I didn't write the original code, but I did convert it to VB.

Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Data
Imports System.Windows.Forms
Imports System.Diagnostics

<ToolboxBitmap(GetType(Label))> _
Public Class TransparentLabel
    Inherits System.Windows.Forms.Control

    Private _textAlign As ContentAlignment = ContentAlignment.TopLeft
    Private _drawFormat As New StringFormat
    Private _textRect As Rectangle = New Rectangle(0, 0, 0, 0)
    Private Const WS_EX_TRANSPARENT As Integer = &H20&
    Private components As System.ComponentModel.Container

    Public Sub New()
        ' This call is required by the Windows Form Designer.
        InitializeComponent()
        SetStyle(ControlStyles.ResizeRedraw, True)
        SetStyle(ControlStyles.Opaque, False)
    End Sub

    Protected Sub InvalidateEx()
        If Me.Parent Is Nothing Then Return
        Dim dirtyRect As Rectangle = New Rectangle(Me.Location, Me.Size)
        Me.Parent.Invalidate(dirtyRect, True)
    End Sub

    Private Sub ResetAlign()
        Select Case _textAlign
            Case ContentAlignment.BottomLeft, ContentAlignment.MiddleLeft, _
                 ContentAlignment.TopLeft
                _drawFormat.Alignment = StringAlignment.Near
            Case ContentAlignment.BottomCenter, ContentAlignment.MiddleCenter, _
                 ContentAlignment.TopCenter
                _drawFormat.Alignment = StringAlignment.Center
            Case ContentAlignment.BottomRight, ContentAlignment.MiddleRight, _
                 ContentAlignment.TopRight
                _drawFormat.Alignment = StringAlignment.Far
        End Select
    End Sub

    Private Sub ResetRect()
        Dim g As Graphics = Me.CreateGraphics
        Dim textSize As SizeF = g.MeasureString(MyBase.Text, Me.Font)
        Select Case _textAlign
            Case ContentAlignment.BottomLeft, ContentAlignment.BottomCenter, _
                 ContentAlignment.BottomRight
                _textRect = New Rectangle(0, Me.ClientRectangle.Height - _
                 CInt(textSize.Height), Me.ClientRectangle.Width, CInt(textSize.Height))
            Case ContentAlignment.MiddleLeft, ContentAlignment.MiddleCenter, _
                 ContentAlignment.MiddleRight
                _textRect = New Rectangle(0, CInt((Me.ClientRectangle.Height - _
                 textSize.Height) / 2), Me.ClientRectangle.Width, CInt(textSize.Height))
            Case ContentAlignment.TopLeft, ContentAlignment.TopCenter, _
                 ContentAlignment.TopRight
                _textRect = New Rectangle_
                (0, 0, Me.ClientRectangle.Width, CInt(textSize.Height))
        End Select
        g.Dispose()
    End Sub

#Region "O V E R R I D E S"
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = cp.ExStyle Or WS_EX_TRANSPARENT
            Return cp
        End Get
    End Property

    Protected Overrides Sub InitLayout()
        MyBase.InitLayout()
        ResetAlign()
        ResetRect()
        'This get's removed immediately upon the first invocation.
        AddHandler Me.Parent.Paint, AddressOf Parent_Paint
    End Sub

    'Must be stubbed out. If you implement this you will loose your transparent background.
    Protected Overrides Sub OnPaintBackground(ByVal pevent As PaintEventArgs)
        'do not allow the background to be painted  
        'Debug.WriteLine( "TransparentLabel(" + this.Name + ")::OnPaintBackground" ) ;
    End Sub

    Protected Overrides Sub OnResize(ByVal e As EventArgs)
        MyBase.OnResize(e)
        ResetRect()
    End Sub

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        Dim g As Graphics = e.Graphics
        Dim fg As Color = Me.ForeColor
        If Not Enabled Then
            fg = SystemColors.GrayText
        End If
        Dim drawBrush As SolidBrush = New SolidBrush(fg)
        g.DrawString(MyBase.Text, Me.Font, drawBrush, _textRect, _drawFormat)
        drawBrush.Dispose()
    End Sub

    Protected Overrides Sub OnEnabledChanged(ByVal e As EventArgs)
        MyBase.OnEnabledChanged(e)
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)
        MyBase.OnFontChanged(e)
        ResetRect()
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnParentChanged(ByVal e As EventArgs)
        MyBase.OnParentChanged(e)
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnVisibleChanged(ByVal e As EventArgs)
        MyBase.OnVisibleChanged(e)
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnTextChanged(ByVal e As EventArgs)
        MyBase.OnTextChanged(e)
        ResetRect()
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnLocationChanged(ByVal e As EventArgs)
        MyBase.OnLocationChanged(e)
        Me.InvalidateEx()
        Me.Invalidate()
    End Sub

    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not components Is Nothing Then
                components.Dispose()
            End If
            _drawFormat.Dispose()
        End If
        MyBase.Dispose(disposing)
    End Sub
#End Region

#Region "Component Designer generated code"
    Private Sub InitializeComponent()
        '
        ' TransparentLabel
        '
        Me.BackColor = SystemColors.Control
        Me.Name = "TransparentLabel"
        Me.Size = New Size(192, 16)
    End Sub
#End Region

#Region "P R O P E R T I E S"
    <Browsable(True)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)> _
    Public Overrides Property Text() As String
        Get
            Return MyBase.Text
        End Get
        Set(ByVal value As String)
            MyBase.Text = value
            Me.InvalidateEx()
        End Set
    End Property

    <Browsable(True)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)> _
    <DefaultValue(ContentAlignment.TopLeft)> _
    Public Property TextAlign() As System.Drawing.ContentAlignment
        Get
            Return _textAlign
        End Get
        Set(ByVal value As System.Drawing.ContentAlignment)
            _textAlign = value
            Me.InvalidateEx()
            ResetAlign()
            ResetRect()
        End Set
    End Property
#End Region

#Region "E V E N T   H A N D L E R S"
    Private Sub Parent_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
        Me.Invalidate()
        'This gets removed immediately upon the first invocation, 
        'because it is just a cludge to stop the text from disappearing when
        'you drop a TranparentLable onto a container.
        'If you don't remove it, you get way-to-many paints.
        RemoveHandler Me.Parent.Paint, AddressOf Parent_Paint
    End Sub
#End Region
End Class

History

• 8^th June, 2010: Initial version