'*************************************************************************************
'* CREATE OUTLINED TEXT USING TRANSPARENT LABELS
'*
'* (OutlinedTranspLabels Sub)Created by Andre Aylestock
'* Original creation date(2002) updated on march 2003
'*''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* PURPOSE : To create outlined text of different size, color and outline thickness using transparent labels.
'* eg: When wanting to display dark text over a dark background or picture.
'* The outline color and thickness can be changed at will so to provide a better contrast with the background area.
'*''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* You are free to use this code as as needed but if you improve on it,
'* or post comment/repply at the link below located at Visual Basic CodeBank of VBForums.com :
'* [url]http://www.vbforums.com/showthread.php?s=&threadid=234071&highlight=outlined+text[/url]
'*''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* INSTRUCTIONS
'* - Paste this entire code inside a module.
'* - On a form, place 1 Label and give it a distinct name such as: Outlbl and make it Index 0
'* - In this case, Outlbl(0) will be your center label. You can also set it up as needed with any of these 5 properties at design time
'* or prior to calling this routine: FontName, FontBold , FontItalic, FontStrikethru or FontUnderline.
'*''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* USAGE :
'* Call the routine to: create or hide outlined text, change the outline color, thickness or hide all text.
'*'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* EXAMPLES:
'* Call OutlinedTranspLabels(Outlbl, InnerAndOutLine, vbCyan, vbBlack, Thick, 22, "This is outlined text with a thick border at center of Form!", Me) 'To get a thick outline around text.
'* Call OutlinedTranspLabels(Outlbl, InnerAndOutLine, vbCyan, vbBlack, Light, 22, "This is outlined text with a light border!") 'To get a thin outline around text.
'* Call OutlinedTranspLabels(Outlbl, InnerOnly, vbCyan, , , 22, "This is normal text !") 'to get normal text or remove outlined around pre-existing text.
'* Call OutlinedTranspLabels(Outlbl, None) 'To remove all text inside your labels.
'*''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'* NOTES:
'* You can use this OutlinedTranspLabels sub as is on forms having scale modes of Twip or Pixel only.
'* The sub here will create borderless labels, so to have borders showing you need to change Outlbl(0).BorderStyle = 1 within the sub.
'* ALSO: If you place your label inside a PictureBox (to be used as the container), make sure to set the PictureBox's scale mode the same as the form it is on.
'* eg: If your form's scalemode is set to twip, set the PictureBox that your label belongs to twip as well.
'* Some fonts will probably also come through better then others so experiment with them and have fun :-)
'*
'*************************************************************************************
Option Explicit
Enum TextVisible
InnerAndOutLine
InnerOnly
None
End Enum
Enum OutlineThickness
Thick = 10
Medium = 0
Light = -10
End Enum
Public Sub OutlinedTranspLabels(ByVal labl As Object, Display As TextVisible, Optional TxtColr As ColorConstants, _
Optional OutlnColr As ColorConstants, Optional OutlnWeight As OutlineThickness, Optional FntSize As Integer, _
Optional strCaption As String, Optional CenterToFormOrPictureBox As Object)
Dim lblLeft As Long, lblTop As Long
Dim I As Integer
Dim TwipstoPixel As Double
'first we need to hide outline labels (if loaded) to reduce
'flickering when positioning them later.
If labl.Count > 1 Then
For I = 1 To 4
labl(I).Visible = False
Next I
End If
'if no text is required then let's erase caption of our main label and exit the sub here.
If Display = None Then
labl(0).Caption = vbNullString
Exit Sub
End If
'text will be required passed this point on so let's prepare our main label
With labl(0)
.BackStyle = vbTransparent
.Caption = strCaption
.ForeColor = TxtColr
If FntSize = 0 Then
FntSize = .FontSize
Else
.FontSize = FntSize
End If
.AutoSize = True
.BorderStyle = 0
'optional centering alignment to a Form or PictureBox
If Not CenterToFormOrPictureBox Is Nothing Then
.Left = (CenterToFormOrPictureBox.ScaleWidth - .Width) / 2
End If
End With
'this determines whether the text will be outlined or not.
If Display = InnerOnly Then
labl(0).Visible = True
Exit Sub
ElseIf Display = InnerAndOutLine Then
labl(0).Visible = True
If labl.Count = 1 Then
For I = 1 To 4
Load labl(I)
Next I
End If
For I = 1 To 4
With labl(I)
.FontSize = FntSize
.ForeColor = OutlnColr
.Caption = strCaption
.ZOrder (0)
End With
Next I
End If
'past this point means our text needs to be outlined, so...
'we'll assign these 2 variables the values needed
'for positioning our outline labels below.
lblLeft = labl(0).Left
lblTop = labl(0).Top
'we also need to determine the form's scalemode in
'order to positioned our outline labels correctly.
'THIS WILL ONLY WORK WITH FORMS HAVING SCALEMODE SET AT PIXEL OR TWIP!
If labl(0).Parent.ScaleMode = 3 Then
TwipstoPixel = Screen.TwipsPerPixelX
ElseIf labl(0).Parent.ScaleMode = 1 Then
TwipstoPixel = 1
End If
'this sets the outlined weight(thickness)and adjusts it according to the fontsize used.
OutlnWeight = FntSize + OutlnWeight
'now let's position our outline labels
labl(1).Move lblLeft - OutlnWeight / TwipstoPixel, lblTop - OutlnWeight / TwipstoPixel
labl(2).Move lblLeft + OutlnWeight / TwipstoPixel, lblTop - OutlnWeight / TwipstoPixel
labl(3).Move lblLeft - OutlnWeight / TwipstoPixel, lblTop + OutlnWeight / TwipstoPixel
labl(4).Move lblLeft + OutlnWeight / TwipstoPixel, lblTop + OutlnWeight / TwipstoPixel
'let's finally display our outline labels since
'they have now been positioned.
'Note: we must unhide them only after they have been positioned
'in order to avoid any flickering from the positioning action.
For I = 1 To 4
With labl(I)
.Visible = True
End With
Next I
'makes our main(center) label top most.
labl(0).ZOrder (0)
End Sub
