Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Public Class SSGlassPanel
Inherits System.Windows.Forms.Panel
#Region "Enumerations"
'************************************************************************************
'*** This region contains enumerations used, mainly, in properties ***
'************************************************************************************
'Enum for bevel styles
Public Enum BevelStyle
None = 0 'No bevel
Inset = 1 'Inset bevel
Raised = 2 'Raised bevel
End Enum
'Enum for coloring styles
Public Enum ColorStyle
Solid = 0 'Solid color
Gradient = 1 'Gradient color
End Enum
#End Region
#Region "Properties classes"
'************************************************************************************
'*** This region contains classes that will be used in properties ***
'************************************************************************************
'Bevel Class
Public Class Bevel
'Bevel style (default: none)
Public Property Style As BevelStyle = BevelStyle.None
'Bevel width (default: 1px)
Public Property Width As Integer = 1
'Bevel light color (default: white)
Public Property LightColor As Color = Color.White
'Bevel dark color (default: dark gray)
Public Property DarkColor As Color = Color.FromArgb(173, 170, 156)
'Empty constructor (to initializate empty bevels)
Friend Sub New()
'Constructor is friend because I don't want users can instantitate Bevel objects
End Sub
'Complete constructor (for use in the TypeConverter)
Friend Sub New(ByVal style As BevelStyle, ByVal width As Integer, ByVal lightColor As Color, ByVal darkColor As Color)
With Me
.Style = style
.Width = width
.LightColor = lightColor
.DarkColor = darkColor
End With
End Sub
'ToString overriding
Public Overrides Function ToString() As String
Dim output As String = String.Empty
'Bevel style
output += Me.Style.ToString + "; "
'Bevel width
output += Me.Width.ToString + "px; "
'Light Color
output += Color2String(Me.LightColor) + "; "
'Dark color
output += Color2String(Me.DarkColor)
Return output
End Function
End Class
'Gradient Class
Public Class Gradient
'Start color
Public Property StartColor As Color = Color.FromArgb(5, 25, 44)
'End color
Public Property EndColor As Color = Color.FromArgb(82, 113, 168)
'Gradient direction
Public Property Direction As Drawing2D.LinearGradientMode = Drawing2D.LinearGradientMode.ForwardDiagonal
'Empty constructor
Friend Sub New()
'Constructor is friend because I don't want users can instantitate Gradient objects
End Sub
'Complete constructor (for use in the TypeConverter)
Friend Sub New(ByVal startColor As Color, ByVal endColor As Color, ByVal direction As Drawing2D.LinearGradientMode)
With Me
.StartColor = startColor
.EndColor = endColor
.Direction = direction
End With
End Sub
'ToString overriding
Public Overrides Function ToString() As String
Dim output As String = String.Empty
'Start color
output += Color2String(Me.StartColor) + "; "
'End color
output += Color2String(Me.EndColor) + "; "
'Direction
output += Me.Direction.ToString
Return output
End Function
End Class
'TextOptions Class
Public Class TextOptions
'Text Style (solid or gradient, default: solid)
'If solid I'll use ForeColor (inherited from Panel); if gradient, I'll use .Gradient
Public Property Style As ColorStyle = ColorStyle.Solid
'Gradient properties (default: white to black vertical gradient)
<TypeConverter(GetType(GradientConverter)), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
Public Property Gradient As Gradient = New Gradient(Color.White, Color.Black, LinearGradientMode.Vertical)
'Outline color (default: black)
Public Property OutlineColor As Color = Color.Black
'Outline width (default: 1px)
Public Property OutlineWidth As Integer = 1
'Reflection (boolean, default: false)
Public Property Reflection As Boolean = False
'Alpha (to use in reflection, default: 100)
Public Property Alpha As Integer = 100
'Offset (space between normal text and reflected text, default: 0px)
Public Property Offset As Integer = 0
'Empty constructor
Friend Sub New()
'Constructor is friend because I don't want users can instantitate TextOptions objects
End Sub
'Complete constructor (for use in the TypeConverter)
Friend Sub New(ByVal style As ColorStyle, ByVal gradient As Gradient, ByVal outlineColor As Color, ByVal outlineWidth As Integer, ByVal reflection As Boolean, ByVal alpha As Integer, ByVal offset As Integer)
With Me
.Style = style
.Gradient = gradient
.OutlineColor = outlineColor
.OutlineWidth = outlineWidth
.Reflection = reflection
.Alpha = alpha
.Offset = offset
End With
End Sub
'ToString overriding
Public Overrides Function ToString() As String
Dim output As String = String.Empty
'Style
output += Me.Style.ToString + "; "
'Gradient
'I can't use ";" as separator of the gradient because the string representation
'is nested in the properties window
output += Me.Gradient.ToString.Replace(";", "-").Replace(" ", String.Empty) + "; "
'Outline color
output += Color2String(Me.OutlineColor) + "; "
'Outline width
output += Me.OutlineWidth.ToString + "px; "
'Reflection
output += Me.Reflection.ToString + "; "
'Alpha
output += Me.Alpha.ToString + "; "
'Offset
output += Me.Offset.ToString
Return output
End Function
End Class
#End Region
#Region "TypeConverter classes"
'************************************************************************************
'*** This region contains the classes that convert Bevel, Gradient and TextOptions***
'*** classes from/to string. This is needed in order to show the properties in the***
'*** properties window ***
'************************************************************************************
'BevelConverter class
Public Class BevelConverter
Inherits ExpandableObjectConverter
Public Overrides Function GetCreateInstanceSupported(context As System.ComponentModel.ITypeDescriptorContext) As Boolean
'Always force a new instance
Return True
End Function
Public Overrides Function CreateInstance(context As System.ComponentModel.ITypeDescriptorContext, propertyValues As System.Collections.IDictionary) As Object
'If GetCreateInstanceSupported returns true, then CreateInstance will be used to create a new instance whenever any of the subproperties of an expandable object are changed.
'The propertyValues argument to CreateInstance provides a set of name/value pairs for the current values of the object's subproperties.
Return New Bevel(DirectCast(propertyValues("Style"), BevelStyle), DirectCast(propertyValues("Width"), Integer), DirectCast(propertyValues("LightColor"), Color), DirectCast(propertyValues("DarkColor"), Color))
End Function
Public Overrides Function CanConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, sourceType As System.Type) As Boolean
'Return true if sourceType is a string
If sourceType = GetType(String) Then
Return True
End If
Return MyBase.CanConvertFrom(context, sourceType)
End Function
Public Overrides Function ConvertTo(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object, destinationType As System.Type) As Object
'Conversion from a Bevel object to a string
If TypeOf value Is Bevel Then
If (destinationType = GetType(String)) Then
Dim bev As Bevel = DirectCast(value, Bevel)
Return bev.ToString
End If
End If
Return MyBase.ConvertTo(context, culture, value, destinationType)
End Function
Public Overrides Function ConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object) As Object
If TypeOf value Is String Then
Try
Dim theString As String = DirectCast(value, String)
Dim properties() As String = theString.Split(";")
Dim output As Bevel = New Bevel
'Style
Select Case properties(0).Trim.ToLower
Case "none"
output.Style = BevelStyle.None
Case "inset"
output.Style = BevelStyle.Inset
Case "raised"
output.Style = BevelStyle.Raised
End Select
'Width
output.Width = Integer.Parse(properties(1).Trim.Replace("px", String.Empty))
'Light color
output.LightColor = String2Color(properties(2).Trim)
'Dark color
output.DarkColor = String2Color(properties(3).Trim)
'It's done
Return output
Catch ex As Exception
Throw New ArgumentException("Invalid arguments." + vbCrLf + ex.ToString)
End Try
End If
Return MyBase.ConvertFrom(context, culture, value)
End Function
End Class
'GradientConverter class
Public Class GradientConverter
Inherits ExpandableObjectConverter
Public Overrides Function GetCreateInstanceSupported(context As System.ComponentModel.ITypeDescriptorContext) As Boolean
'Always force a new instance
Return True
End Function
Public Overrides Function CreateInstance(context As System.ComponentModel.ITypeDescriptorContext, propertyValues As System.Collections.IDictionary) As Object
'If GetCreateInstanceSupported returns true, then CreateInstance will be used to create a new instance whenever any of the subproperties of an expandable object are changed.
'The propertyValues argument to CreateInstance provides a set of name/value pairs for the current values of the object's subproperties.
Return New Gradient(DirectCast(propertyValues("StartColor"), Color), DirectCast(propertyValues("EndColor"), Color), DirectCast(propertyValues("Direction"), Drawing2D.LinearGradientMode))
End Function
Public Overrides Function CanConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, sourceType As System.Type) As Boolean
'Return true if sourceType is a string
If sourceType = GetType(String) Then
Return True
End If
Return MyBase.CanConvertFrom(context, sourceType)
End Function
Public Overrides Function ConvertTo(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object, destinationType As System.Type) As Object
If TypeOf value Is Gradient Then
If (destinationType = GetType(String)) Then
Dim grad As Gradient = DirectCast(value, Gradient)
Return grad.ToString
End If
End If
Return MyBase.ConvertTo(context, culture, value, destinationType)
End Function
Public Overrides Function ConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object) As Object
If TypeOf value Is String Then
Try
Dim theString As String = DirectCast(value, String)
Dim properties() As String = theString.Split(";")
Dim output As Gradient = New Gradient
'Start color
output.StartColor = String2Color(properties(0).Trim)
'End color
output.EndColor = String2Color(properties(1).Trim)
'Direction
output.Direction = DirectCast([Enum].Parse(GetType(Drawing2D.LinearGradientMode), properties(2).Trim), Drawing2D.LinearGradientMode)
'It's done
Return output
Catch ex As Exception
Throw New ArgumentException("Invalid arguments." + vbCrLf + ex.ToString)
End Try
End If
Return MyBase.ConvertFrom(context, culture, value)
End Function
End Class
'TextOptionsConverter class
Public Class TextOptionsConverter
Inherits ExpandableObjectConverter
Public Overrides Function GetCreateInstanceSupported(context As System.ComponentModel.ITypeDescriptorContext) As Boolean
'Always force a new instance
Return True
End Function
Public Overrides Function CreateInstance(context As System.ComponentModel.ITypeDescriptorContext, propertyValues As System.Collections.IDictionary) As Object
'If GetCreateInstanceSupported returns true, then CreateInstance will be used to create a new instance whenever any of the subproperties of an expandable object are changed.
'The propertyValues argument to CreateInstance provides a set of name/value pairs for the current values of the object's subproperties.
Return New TextOptions(DirectCast(propertyValues("Style"), ColorStyle), DirectCast(propertyValues("Gradient"), Gradient), DirectCast(propertyValues("OutlineColor"), Color), DirectCast(propertyValues("OutlineWidth"), Integer), DirectCast(propertyValues("Reflection"), Boolean), DirectCast(propertyValues("Alpha"), Integer), DirectCast(propertyValues("Offset"), Integer))
End Function
Public Overrides Function CanConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, sourceType As System.Type) As Boolean
'Return true if sourceType is a string
If sourceType = GetType(String) Then
Return True
End If
Return MyBase.CanConvertFrom(context, sourceType)
End Function
Public Overrides Function ConvertTo(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object, destinationType As System.Type) As Object
If TypeOf value Is TextOptions Then
If (destinationType = GetType(String)) Then
Dim options As TextOptions = DirectCast(value, TextOptions)
Return options.ToString
End If
End If
Return MyBase.ConvertTo(context, culture, value, destinationType)
End Function
Public Overrides Function ConvertFrom(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object) As Object
If TypeOf value Is String Then
Try
Dim theString As String = DirectCast(value, String)
Dim properties() As String = theString.Split(";")
Dim output As TextOptions = New TextOptions
'Style
Select Case properties(0).Trim.ToLower
Case "solid"
output.Style = ColorStyle.Solid
Case "gradient"
output.Style = ColorStyle.Gradient
End Select
'Gradient
Dim gradProperties() As String = properties(1).Trim.Split("-")
output.Gradient.StartColor = String2Color(gradProperties(0).Trim)
output.Gradient.EndColor = String2Color(gradProperties(1).Trim)
output.Gradient.Direction = DirectCast([Enum].Parse(GetType(Drawing2D.LinearGradientMode), gradProperties(2).Trim), Drawing2D.LinearGradientMode)
'Outline Color
output.OutlineColor = String2Color(properties(2).Trim)
'Outline width
output.OutlineWidth = Integer.Parse(properties(3).Trim.Replace("px", String.Empty))
'Reflection
output.Reflection = Boolean.Parse(properties(4).Trim)
'Alpha
output.Alpha = Integer.Parse(properties(5).Trim)
'Offset
output.Offset = Integer.Parse(properties(6).Trim)
'It's done
Return output
Catch ex As Exception
Throw New ArgumentException("Invalid arguments." + vbCrLf + ex.ToString)
End Try
End If
Return MyBase.ConvertFrom(context, culture, value)
End Function
End Class
#End Region
#Region "Variables to hold properties values"
'************************************************************************************
'*** This region contains variables which hold the values of control properties ***
'************************************************************************************
'OuterBevel (default: bevel with no style)
Private _outerBevel As Bevel = New Bevel(BevelStyle.None, 1, Color.White, Color.FromArgb(173, 170, 156))
'InnerBevel (default: bevel with no style)
Private _innerBevel As Bevel = New Bevel(BevelStyle.None, 1, Color.White, Color.FromArgb(173, 170, 156))
'Intra-bevel spacing (space between outer and inner bevels, default: 2px)
Private _bevelSpacing As Integer = 2
'Intra-bevel fill color (color to fill the space between outer and inner bevels, default: Control)
Private _bevelSpacingColor As Color = SystemColors.Control
'Background style (solid or gradient, default: solid)
'If solid I'll use BackColor (inherited from Panel); if gradient, I'll use BackgroundGradient
Private _backgroundStyle As ColorStyle = ColorStyle.Solid
'Background gradient (for use when BackgroundStyle = Gradient, default: nice blue gradient)
Private _backgroundGradient As Gradient = New Gradient(Color.FromArgb(5, 25, 44), Color.FromArgb(82, 113, 168), Drawing2D.LinearGradientMode.ForwardDiagonal)
'Control text (default: SSPanel)
Private _text As String = "SSGlassPanel"
'Text alignment (default: middle-center)
Private _textAlign As ContentAlignment = ContentAlignment.MiddleCenter
'Text options
Private _textStyle As TextOptions = New TextOptions(ColorStyle.Solid, New Gradient(Color.White, Color.Black, LinearGradientMode.Vertical), Color.Black, 1, False, 100, 0)
#End Region
#Region "Properties"
'************************************************************************************
'*** This region contains the public properties of the control. All of them ***
'*** end with a call to .Invalidate in order to redraw the control ***
'************************************************************************************
'Outer Bevel
<TypeConverter(GetType(BevelConverter)), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
Public Property OuterBevel As Bevel
Get
Return _outerBevel
End Get
Set(value As Bevel)
_outerBevel = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Inner Bevel
<TypeConverter(GetType(BevelConverter)), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
Public Property InnerBevel As Bevel
Get
Return _innerBevel
End Get
Set(value As Bevel)
_innerBevel = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Intra-bevel spacing
Public Property BevelSpacing As Integer
Get
Return _bevelSpacing
End Get
Set(value As Integer)
_bevelSpacing = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Intra-bevel fill color
Public Property BevelSpacingColor As Color
Get
Return _bevelSpacingColor
End Get
Set(value As Color)
_bevelSpacingColor = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Background style
Public Property BackgroundStyle As ColorStyle
Get
Return _backgroundStyle
End Get
Set(value As ColorStyle)
_backgroundStyle = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Background gradient
<TypeConverter(GetType(GradientConverter)), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
Public Property BackgroundGradient As Gradient
Get
Return _backgroundGradient
End Get
Set(value As Gradient)
_backgroundGradient = value
If Me.BackgroundStyle = ColorStyle.Gradient Then
'Redraw the control
Me.Invalidate()
End If
End Set
End Property
'Control text
<Browsable(True)> _
Public Overrides Property Text As String
Get
Return _text
End Get
Set(value As String)
_text = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Text alignment
Public Property TextAlignment As ContentAlignment
Get
Return _textAlign
End Get
Set(value As ContentAlignment)
_textAlign = value
'Redraw the control
Me.Invalidate()
End Set
End Property
'Text options
<TypeConverter(GetType(TextOptionsConverter)), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
Public Property TextStyle As TextOptions
Get
Return _textStyle
End Get
Set(value As TextOptions)
_textStyle = value
'Redraw the control
Me.Invalidate()
End Set
End Property
#End Region
#Region "Private functions"
'************************************************************************************
'*** This region contains private multi-purpose utility functions ***
'************************************************************************************
'Convert from a color to its string representation (if it's a named color, use name; instead, use R,G,B)
Private Shared Function Color2String(ByVal c As Color) As String
Return IIf(c.IsNamedColor, c.Name, c.R.ToString + ", " + c.G.ToString + ", " + c.B.ToString)
End Function
'Convert from a color string to a color
Private Shared Function String2Color(ByVal s As String) As Color
If s.Contains(",") Then
'is a r,b,g formatted color
Dim colorData() As String = s.Split(",")
Return Color.FromArgb(Integer.Parse(colorData(0).Trim), Integer.Parse(colorData(1).Trim), Integer.Parse(colorData(2).Trim))
Else
'is a named color
Return Color.FromName(s)
End If
End Function
#End Region
#Region "Painting"
'************************************************************************************
'*** This region contains the override of the OnPaint event. Here I'll do all the ***
'*** graphics work ***
'************************************************************************************
Protected Overrides Sub OnPaintBackground(pevent As System.Windows.Forms.PaintEventArgs)
'I want to draw the background myself, so I'll do it in OnPaint
End Sub
Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
'********************************************************************************
'*** Base painting ***
'********************************************************************************
MyBase.OnPaint(e)
Try
'********************************************************************************
'*** Custom painting ***
'********************************************************************************
'I'll paint the objects from outside to inside (eg. first outer bevel (if exists),
'then inner bevel (if exists), then background and finally text. So I get the
'initial ClipRectangle and I'll be deflating it as I need
Dim cr As Rectangle = e.ClipRectangle
'********************************************************************************
'*** Outer Bevel ***
'********************************************************************************
'If outer bevel style is set to anything...
If Me.OuterBevel.Style <> BevelStyle.None Then
'Draw the bevel
Call DrawBevel(e.Graphics, cr, Me.OuterBevel)
'Deflate the clip rectangle
cr.Inflate(Me.OuterBevel.Width * -1, Me.OuterBevel.Width * -1)
'****************************************************************************
'*** Inner Bevel ***
'****************************************************************************
'Drawing of the inner bevel is inside this "if" because an inner bevel is not
'necessary if there is not an outer bevel. If you want just one bevel, simply
'use outer bevel.
If Me.InnerBevel.Style <> BevelStyle.None Then
'First, deflate the rectangle with the intra-bevel space
cr.Inflate(Me.BevelSpacing * -1, Me.BevelSpacing * -1)
'Draw the bevel
Call DrawBevel(e.Graphics, cr, Me.InnerBevel)
'Deflate the clip rectangle
cr.Inflate(Me.InnerBevel.Width * -1, Me.InnerBevel.Width * -1)
'Color the intra-bevel space
Dim rect1 As Rectangle = New Rectangle(Me.OuterBevel.Width, Me.OuterBevel.Width, Me.Width - (Me.OuterBevel.Width * 2), Me.BevelSpacing)
Dim rect2 As Rectangle = New Rectangle(Me.OuterBevel.Width, Me.Height - Me.OuterBevel.Width - Me.BevelSpacing, Me.Width - (Me.OuterBevel.Width * 2), Me.BevelSpacing)
Dim rect3 As Rectangle = New Rectangle(Me.OuterBevel.Width, Me.OuterBevel.Width + Me.BevelSpacing, Me.BevelSpacing, Me.Height - (Me.OuterBevel.Width * 2) - (Me.BevelSpacing * 2))
Dim rect4 As Rectangle = New Rectangle(Me.Width - Me.OuterBevel.Width - Me.BevelSpacing, Me.OuterBevel.Width + Me.BevelSpacing, Me.BevelSpacing, Me.Height - (Me.OuterBevel.Width * 2) - (Me.BevelSpacing * 2))
Using brush As SolidBrush = New SolidBrush(Me.BevelSpacingColor)
e.Graphics.FillRectangle(brush, rect1)
e.Graphics.FillRectangle(brush, rect2)
e.Graphics.FillRectangle(brush, rect3)
e.Graphics.FillRectangle(brush, rect4)
End Using
End If
End If
'********************************************************************************
'*** Background ***
'********************************************************************************
If Me.BackgroundStyle = ColorStyle.Solid Then
'Create a brush with the BackColor and fill the rectangle
Using b As SolidBrush = New SolidBrush(Me.BackColor)
e.Graphics.FillRectangle(b, cr)
End Using
Else
'Create a gradient brush and fill the rectangle
Using b As Drawing2D.LinearGradientBrush = New Drawing2D.LinearGradientBrush(cr, Me.BackgroundGradient.StartColor, Me.BackgroundGradient.EndColor, Me.BackgroundGradient.Direction)
e.Graphics.FillRectangle(b, cr)
End Using
'For some unknown reason, the top-left pixel of the cliprectangle appears in a
'different color. WTF?
'Anyway, fill it.
Using b As SolidBrush = New SolidBrush(Me.BackgroundGradient.StartColor)
e.Graphics.FillRectangle(b, New Rectangle(cr.X, cr.Y, 1, 1))
End Using
End If
'********************************************************************************
'*** Text ***
'********************************************************************************
If Me.Text.Length > 0 Then
If Me.TextStyle.Reflection Then
'Apply high-quality properties to the graphics object
'If not, lines can flicker and final result will not be perfect
With e.Graphics
.CompositingQuality = CompositingQuality.HighQuality
.InterpolationMode = InterpolationMode.HighQualityBicubic
.PixelOffsetMode = PixelOffsetMode.HighQuality
.SmoothingMode = SmoothingMode.HighQuality
.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
End With
'Get text dimensions
Dim width As Single = e.Graphics.MeasureString(Me.Text, Me.Font).Width
Dim height As Single = e.Graphics.MeasureString(Me.Text, Me.Font).Height
'Create a rectangle to hold the position & size of the text drawn
Dim xpos As Integer, ypos As Integer
Select Case Me.TextAlignment
Case ContentAlignment.TopLeft
xpos = cr.Left
ypos = cr.Top
Case ContentAlignment.TopCenter
xpos = cr.Left + ((cr.Width - width) / 2)
ypos = cr.Top
Case ContentAlignment.TopRight
xpos = cr.Right - width
ypos = cr.Top
Case ContentAlignment.MiddleLeft
'For all Middle- values, the y position must be vertically centered, so we start from
'(rectangle height - text height) / 2
'But below the normal text will be the reflected text, so must offset to top
'the half of text height
'Additionally, MeasureString give us extra space reserved for tall glyphos,
'so must consider the Offset value to delete this extra space, so must offset
'to bottom the half of Offset value
'Aditionally, we must offset the top of the current clip rectangle
xpos = cr.Left
'ypos = cr.Top + (((cr.Height - height) / 2) - (height / 2) + (Me.TextStyle.Offset / 2))
ypos = cr.Top + ((cr.Height - height) / 2) - (height / 2) + (Me.TextStyle.Offset / 2)
Case ContentAlignment.MiddleCenter
xpos = cr.Left + ((cr.Width - width) / 2)
ypos = cr.Top + ((cr.Height - height) / 2) - (height / 2) + (Me.TextStyle.Offset / 2)
Case ContentAlignment.MiddleRight
xpos = cr.Right - width
ypos = cr.Top + ((cr.Height - height) / 2) - (height / 2) + (Me.TextStyle.Offset / 2)
Case ContentAlignment.BottomLeft
xpos = cr.Left
ypos = cr.Bottom - (height * 2) + (Me.TextStyle.Offset / 2)
Case ContentAlignment.BottomCenter
xpos = cr.Left + ((cr.Width - width) / 2)
ypos = cr.Bottom - (height * 2) + (Me.TextStyle.Offset / 2)
Case ContentAlignment.BottomRight
xpos = cr.Right - width
ypos = cr.Bottom - (height * 2) + (Me.TextStyle.Offset / 2)
End Select
'Create the rectangle
Dim originalRect As New RectangleF(xpos, ypos, width, height)
'Draw the original string. We'll use a GraphicsPath object instead
'using DrawString directly, because GraphicsPath will let us draw an
'outline border to the text
'Create the path
Dim path As GraphicsPath = New GraphicsPath
'Add the string to the path. Because GraphicsPath's AddString method
'uses emSize (the height of the em square box that bounds the character)
'instead of Point, we must convert out font's Point size to emSize using
'this formula: (Vertical Resolution / 72) * Font's Point Size
path.AddString(Me.Text, Me.Font.FontFamily, Me.Font.Style, (e.Graphics.DpiY / 72) * Me.Font.Size, originalRect, StringFormat.GenericDefault)
'If and outline must be drawn, draw it
If Me.TextStyle.OutlineWidth > 0 Then
Using p As Pen = New Pen(Me.TextStyle.OutlineColor, Me.TextStyle.OutlineWidth)
e.Graphics.DrawPath(p, path)
End Using
End If
'Create the brush to fill the text
Dim fill As Brush
If Me.TextStyle.Style = ColorStyle.Gradient Then
'Text must be filled with a gradient brush
fill = New LinearGradientBrush(originalRect, Me.TextStyle.Gradient.StartColor, Me.TextStyle.Gradient.EndColor, Me.TextStyle.Gradient.Direction)
Else
'Text must be filled with a solid brush
fill = New SolidBrush(Me.ForeColor)
End If
'Fill the text and destroy the brush
e.Graphics.FillPath(fill, path)
fill.Dispose()
'The GraphicsPath object won't be needed anymore
path.Dispose()
'From this point we must deal with reflected text. So it's a good idea to
'save the current state of our graphics object. What is really saved is the
'state of the objects (transformations applied, etc), not the drawings done
'until here.
Dim state As GraphicsState = e.Graphics.Save
'Reset the transformations done until here so we start from a "fresh clean"
'graphics object state.
e.Graphics.ResetTransform()
'ScaleTransform will set the graphics object into a state in which all the
'drawings done after the instruction will be affected by the scaling done.
'As we use 1 for horizontal value, the drawings will be not changed in the
'horizontal plane. But as we use -1 for the vertical value, all the drawings
'will be vertically inverted (the reflection effect that we want).
e.Graphics.ScaleTransform(1, -1)
'Now, as we did for the normal text, we'll create a rectangle that delimites
'the position and size of the reflected text
'The x-position must not be changed, as it is the same that the normal text
'The y-pos must be changed
ypos = ypos + (height * 2) - (Me.TextStyle.Offset)
ypos *= -1
'Create the rectangle
Dim reflectedRect As New RectangleF(xpos, ypos, width, height)
'Create the path to hold the text
Dim reflectedPath As GraphicsPath = New GraphicsPath
'Add the string to the path
reflectedPath.AddString(Me.Text, Me.Font.FontFamily, Me.Font.Style, (e.Graphics.DpiY / 72) * Me.Font.Size, reflectedRect, StringFormat.GenericDefault)
'Draw the outline, if it applies
If Me.TextStyle.OutlineWidth > 0 Then
'Note that we apply alpha transparency to the outline. If not, reflected
'text's outline will appear too much "solid"
Using p As Pen = New Pen(Color.FromArgb(Me.TextStyle.Alpha, Me.TextStyle.OutlineColor), Me.TextStyle.OutlineWidth)
e.Graphics.DrawPath(p, reflectedPath)
End Using
End If
'Create the brush to fill the reflected text
If Me.TextStyle.Style = ColorStyle.Gradient Then
'We must apply Alpha transparency on both gradient colors
fill = New LinearGradientBrush(reflectedRect, Color.FromArgb(Me.TextStyle.Alpha, Me.TextStyle.Gradient.StartColor), Color.FromArgb(Me.TextStyle.Alpha, Me.TextStyle.Gradient.EndColor), Me.TextStyle.Gradient.Direction)
Else
'Apply Alpha to solid color too
fill = New SolidBrush(Color.FromArgb(Me.TextStyle.Alpha, Me.ForeColor))
End If
'Draw the text (it will be automatically reflected because of the Scale
'transformation applied)
e.Graphics.FillPath(fill, reflectedPath)
'Destroy objects that are no more needed
fill.Dispose()
reflectedPath.Dispose()
'Restore the Graphics object state (eliminate transformations, so if we drew
'anymore from here will not be reflected)
e.Graphics.Restore(state)
Else
'The simple way: no reflection, no calculations, etc
'Simply draw the text using DrawText
'Create a brush to draw the text
Using b As SolidBrush = New SolidBrush(Me.ForeColor)
'Select text position depending on TextAlignment
Using sf As StringFormat = StringFormat.GenericDefault
Select Case Me.TextAlignment
Case ContentAlignment.TopLeft
sf.Alignment = StringAlignment.Near
sf.LineAlignment = StringAlignment.Near
Case ContentAlignment.TopCenter
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Near
Case ContentAlignment.TopRight
sf.Alignment = StringAlignment.Far
sf.LineAlignment = StringAlignment.Near
Case ContentAlignment.MiddleLeft
sf.Alignment = StringAlignment.Near
sf.LineAlignment = StringAlignment.Center
Case ContentAlignment.MiddleCenter
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
Case ContentAlignment.MiddleRight
sf.Alignment = StringAlignment.Far
sf.LineAlignment = StringAlignment.Center
Case ContentAlignment.BottomLeft
sf.Alignment = StringAlignment.Near
sf.LineAlignment = StringAlignment.Far
Case ContentAlignment.BottomCenter
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Far
Case ContentAlignment.BottomRight
sf.Alignment = StringAlignment.Far
sf.LineAlignment = StringAlignment.Far
End Select
'Draw the text
e.Graphics.DrawString(Me.Text, Me.Font, b, cr, sf)
End Using
End Using
End If
End If
Catch ex As Exception
End Try
End Sub
'Draw a Bevel into a graphics object
'In fact a bevel is nothing but a rectangle; 2 lines of the rectangle are dark-colored
'and the 2 other are light-colored, depending on the bevel style (inset or raised)
Private Sub DrawBevel(ByVal g As Graphics, ByVal rect As Rectangle, ByVal b As Bevel)
If b.Style = BevelStyle.Inset Then
'Draw an inset bevel
Call DrawInsetBevel(g, rect, b)
ElseIf b.Style = BevelStyle.Raised Then
'Draw a raised bevel
Call DrawRaisedBevel(g, rect, b)
End If
End Sub
'Draw a raised bevel into a graphics object
Private Sub DrawRaisedBevel(ByVal g As Graphics, ByVal rect As Rectangle, ByVal b As Bevel)
'Draw dark lines
Dim pen As Pen = New Pen(b.LightColor, b.Width)
Dim left As Integer = b.Width \ 2
left += rect.Left
g.DrawLine(pen, left, rect.Top, left, rect.Bottom)
Dim top As Integer = b.Width \ 2
top += rect.Top
g.DrawLine(pen, left, top, rect.Right, top)
pen.Dispose()
'Draw light lines
pen = New Pen(b.DarkColor, b.Width)
left = rect.Right - ((b.Width + 1) \ 2)
g.DrawLine(pen, left, rect.Top, left, rect.Bottom)
top = rect.Bottom - ((b.Width + 1) \ 2)
g.DrawLine(pen, rect.Left, top, rect.Right, top)
pen.Dispose()
End Sub
'Draw an inset bevel into a rectangle
Private Sub DrawInsetBevel(ByVal g As Graphics, ByVal rect As Rectangle, ByVal b As Bevel)
'Draw dark lines
Dim pen As Pen = New Pen(b.DarkColor, b.Width)
Dim left As Integer = b.Width \ 2
left += rect.Left
g.DrawLine(pen, left, rect.Top, left, rect.Bottom)
Dim top As Integer = b.Width \ 2
top += rect.Top
g.DrawLine(pen, left, top, rect.Right, top)
pen.Dispose()
'Draw light lines
pen = New Pen(b.LightColor, b.Width)
left = rect.Right - ((b.Width + 1) \ 2)
g.DrawLine(pen, left, rect.Top, left, rect.Bottom)
top = rect.Bottom - ((b.Width + 1) \ 2)
g.DrawLine(pen, rect.Left, top, rect.Right, top)
pen.Dispose()
End Sub
#End Region
End Class
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (4)
Author
Commented:Open in new window
Author
Commented:Commented:
Author
Commented: