Transparent Label in VB
A VB conversion of a C# Transparent Label control
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#:
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
- 8th June, 2010: Initial version