Introduction.
The 3D-style heading text, as shown above, can be created quickly in Microsoft Access by layering multiple copies of the same label. Simply copy and paste the label five to seven times, each with the same caption text. Then, offset each duplicate slightly upward and to the left or right to create a shadow-like depth effect. You can customize the topmost label with a brighter font color and use darker shades for the underlying labels to enhance the 3D appearance. This approach offers an easy and effective way to add visual appeal to your Form or Report headers.
The 3D text design can be customized by using Label controls with your desired caption, font style, size, color, bold, or italic formatting. For dynamic content, you can also create a similar 3D effect using TextBox controls, allowing you to display information from table or query fields directly on the form or report.
Before proceeding further, ensure that all essential project library references have been linked to your database. Failing to do so may result in runtime errors. Please refer to the earlier post on Command Button Animation and follow the steps outlined there to link the necessary library files to your project.
The VBA Code
Copy and paste the following code into a new Global Module and save it:
Option Compare Database
Option Explicit
'-- Global declarations
Private Const lngheight as long = 0.45 * 1440
Private Const lngWidth as long = 4.5 * 1440
Private Const intFontSize as integer = 26
Private Const intTextAlign as integer = 0
Private Const intBackStyle as integer = 0
Private Const LngI as long = 0.0104 * 1440
Private Const intX as long = 0.15 * 1440
Private Const intY as long = 0.15 * 1440
Dim MyFrm As Form
Public Function FormTxtLabels(Optional ByVal ControlType As Integer) As String
'---------------------------------------------------
'Author : a.p.r. pillai
'Date : September 2006
'ControlType = 0 for label
'ControlTYPE = 1 for TextBox
'---------------------------------------------------
Dim ctl As Control
'On Error GoTo FormTxtLabels_Err
If ControlType > 0 Then ControlType = 1
Set MyFrm = CreateForm
If ControlType = 1 Then
Set ctl = CreateControl(MyFrm.NAME, acTextBox, acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight)
With ctl
.ControlSource = "=" & Chr(34) & "msaccesstips.com" & Chr(34)
End With
Else
Set ctl = CreateControl(MyFrm.NAME, acLabel, _acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight)
With ctl
.Caption = "msaccesstips.com"
End With
End If
FormTxtLabels = MyFrm.NAME
FormTxtLabels_Exit:
Exit Function
FormTxtLabels_Err:
MsgBox Err.Description, , "FormTxtLabels"
FormTxtLabels = ""
Resume FormTxtLabels_Exit
End Function
Public Function Validate_Dup(ByRef MyFrm As Form, ByVal intNooflabels As Integer) As Integer
'---------------------------------------------------
'Author : a.p.r. pillai
'Date : September 2006
'ControlType = 0 for label
'ControlTYPE = 1 for TextBox
'---------------------------------------------------
Dim mysec As Section, lblcount As Integer
Dim myctrl As Control, newctrl As Control, j As Integer
Dim lngx As Long, lngY As Long, lngH As Long, lngW As Long
Dim strCap As String, ctrltype As Integer, intlbls As Integer
Dim ctrlName() As String, ctrlIndex() As Integer, i As Long
Dim strFont As String, intFntSize As Integer, x As Integer
Dim intFntWeight As Integer
'On Error GoTo Validate_Dup_Err
Set mysec = MyFrm.Section(acDetail)
intlbls = mysec.Controls.Count - 1
Set myctrl = mysec.Controls(0)
ctrltype = myctrl.ControlType
intNooflabels = intNooflabels - 1
If intlbls > 0 Then
ReDim ctrlName(intlbls) As String
ReDim ctrlIndex(intlbls) As Integer
End If
If ctrltype = 109 And intlbls > 0 Then
For j = 0 To intlbls
Set myctrl = mysec.Controls(j)
ctrlIndex(j) = myctrl.ControlType
ctrlName(j) = myctrl.NAME
Next
For j = 0 To intlbls
If ctrlIndex(j) = 100 Then
DeleteControl MyFrm.NAME, ctrlName(j)
End If
Next
intlbls = mysec.Controls.Count - 1
End If
Set myctrl = mysec.Controls(0)
If intlbls < intNooflabels Then
With myctrl
lngx = .Left
lngY = .Top
lngW = .Width
lngH = 0.0208 * 1440 ' 0.0208 inches
strFont = .FontName
intFntSize = .FontSize
intFntWeight = .FontWeight
End With
If ctrltype = 100 Then
strCap = myctrl.Caption
ElseIf ctrltype = 109 Then
strCap = myctrl.ControlSource
End If
If ctrltype = 109 And intlbls > 0 Then
For j = 0 To intlbls
Set myctrl = mysec.Controls(j)
ctrlIndex(j) = myctrl.ControlType
ctrlName(j) = myctrl.NAME
Next
For j = 0 To intlbls
If ctrlIndex(j) = 100 Then
DeleteControl MyFrm.NAME, ctrlName(j)
End If
Next
intlbls = mysec.Controls.Count - 1
Set myctrl = mysec.Controls(intlbls)
With myctrl
lngx = .Left
lngY = .Top
lngW = .Width
lngH = .Height
ctrltype = .ControlType
strFont = .FontName
intFntSize = .FontSize
intFntWeight = .FontWeight
End With
End If
i = 0.0104 * 1440 + lngH ' 0.0104 inches
lngY = lngY + i
For j = intlbls + 1 To intNooflabels
Set newctrl = CreateControl(MyFrm.NAME, ctrltype, _acDetail, "","", lngx, lngY, lngW, lngH)
If ctrltype = 100 Then
newctrl.Caption = strCap
newctrl.FontName = strFont
newctrl.FontSize = intFntSize
newctrl.FontWeight = intFntWeight
Else
newctrl.ControlSource = strCap
newctrl.FontName = strFont
newctrl.FontSize = intFntSize
newctrl.FontWeight = intFntWeight
End If
lngY = lngY + i
Next
End If
If intlbls > intNooflabels Then
For j = intNooflabels + 1 To intlbls
Set myctrl = mysec.Controls(j)
ctrlIndex(j) = myctrl.ControlType
ctrlName(j) = myctrl.NAME
Next
For j = intNooflabels + 1 To intlbls
DeleteControl MyFrm.NAME, ctrlName(j)
Next
Validate_Dup = 0
End If
intlbls = mysec.Controls.Count - 1
Set myctrl = mysec.Controls(0)
ctrltype = myctrl.ControlType
If ctrltype = 109 Then
For j = 0 To intlbls
Set myctrl = mysec.Controls(j)
With myctrl
.Enabled = False
.Locked = True
.SpecialEffect = 0
End With
Next
End If
Validate_Dup = 0
Validate_Dup_Exit:
Exit Function
Validate_Dup_Err:
MsgBox Err.Description, ,"Validate_Dup"
Validate_Dup = 1
Resume Validate_Dup_Exit
End Function
Public Function MsgLabel() '------------------------------------------------------------ 'Author : a.p.r. pillai 'Date : September 2006 '------------------------------------------------------------ Dim mySection As Section, ctl As Control, xForm As Form Dim l As Long, t As Long, w As Long, h As Long, F As Long F = 1440 l = 0.5 * F: t = 1.2 * F: w = 3.6563 * F: h = 0.4896 * F 'values in inches On Error Resume Next Set mySection = MyFrm.Section(acDetail) Set ctl = CreateControl(MyFrm.NAME, acLabel, _acDetail, , "", l, t, w, h) ctl.Caption = "Click outside the Controls and Drag Over. " & "Display the Property Sheet. " & "Type New Text for Caption/Control " & "Source Property area for Label/ Text Boxes. " & "Copy and Paste the Controls to " & "Target Form/Report Area." End Function
Public Function Heading3D(ByVal intStyle As Integer, ByVal intForeColor As Integer, _
Optional ByVal Label0Text1 As Integer) As String
'------------------------------------------------------------
'Author : a.p.r. pillai
'Date : September 2006
'------------------------------------------------------------
Dim intlbls As Integer, mySection As Section
Dim j As Integer, intFSize As Integer
Dim lblName() As String, lngForecolor As Long, x As Integer
Dim l As Long, t As Long
On Error Resume Next
Heading3D = FormTxtLabels(Label0Text1)
Set mySection = MyFrm.Section(acDetail)
intlbls = mySection.Controls.Count - 1
On Error GoTo Heading3D_Err
x = Validate_Dup(MyFrm, 5) 'check type and duplicate
If x = 1 Then
Exit Function
End If
intlbls = mySection.Controls.Count - 1
x = intStyle
intStyle = IIf(x < 0, 0, IIf(x > 3, 3, intStyle))
x = intForeColor
intForeColor = IIf(x < 0, 0, IIf(x > 15, 15, intForeColor))
ReDim lblName(0 To intlbls) As String
For j = 0 To intlbls
lblName(j) = mySection.Controls(j).NAME
Next
For j = 0 To intlbls
With mySection.Controls(lblName(j))
.Height = lngheight
.Width = lngWidth
.FontName = "Times New Roman"
intFSize = .FontSize
If intFSize < intFontSize Then
.FontSize = intFontSize
End If
.FontUnderline = False
.TextAlign = intTextAlign
.BackStyle = intBackStyle
Select Case j
Case 0
lngForecolor = 0
Case 1 To intlbls - 2
lngForecolor = 9868950
Case intlbls - 1
lngForecolor = 16777215
Case intlbls
lngForecolor = QBColor(intForeColor)
End Select
.ForeColor = lngForecolor
End With
Next
l = intX: t = intY
With mySection.Controls(lblName(1))
.Left = l
.Top = t
End With
For j = 0 To intlbls
Select Case intStyle
Case 0
l = l + LngI
t = t + LngI
Case 1
l = l + LngI
t = t - LngI
Case 3
l = l - LngI
t = t - LngI
Case 2
l = l - LngI
t = t + LngI
End Select
With mySection.Controls(lblName(j))
.Left = l
.Top = t
End With
Next
MsgLabel
Heading3D_Exit:
Exit Function
Heading3D_Err:
Msgbox Err.Description, ,"Heading3D"
Resume Heading3D_Exit
End Function
How the Functions are Used
The first 3 Functions in the above code:
FormTxtLabels()
Validate_Dup()
MsgLabel()
The above-listed functions are called from the Heading3D() Function and will be used for other forthcoming Heading Styles.
How to Create a Customizable Sample 3D Heading
To create the 3D-Heading on a new Form, display the Visual Basic Window (if not already open) and press Alt+F11. Press Ctrl+G (or select the Immediate Window option from the View menu) to display the Debug Window.
Type the next line in the immediate window and press the Enter key:
Heading3D 1, 0
@@@When the module window refreshes, it will briefly flash. Minimize the Visual Basic Editor window, and you’ll see a new form (named something like Form1) created with a 3D heading. This heading displays the default text msaccesstips.com, along with a help message suggesting possible modifications.
To reuse the 3D heading:
-
Select all the controls by clicking outside the Labels and dragging the mouse over all of them.
-
Copy and paste the selection into your own Form or Report.
-
With all controls still selected, open the Property Sheet and change the Caption property to your desired text.
-
You can also modify font settings such as Bold, Italic, or Font Name as needed.
-
To change the text color, carefully click only the topmost label (to avoid misaligning it) and apply the color of your choice.
-
If you accidentally select all controls and apply color changes to the entire group, simply press Ctrl+Z to undo.
Defining the Shadow Position
The position of the 3D-Text shadow can be controlled by the first parameter value of the Function, and the following values are used:
- - Shadow tilted to the top left corner
- - Left Bottom Corner
- - Right top Corner
- - Bottom Right corner
The second parameter of the function determines the type of 3D heading:
-
A value of 0 creates a Label-based 3D heading.
-
A value of 1 creates a TextBox-based 3D heading, with its Control Source property set to a formula for displaying data.
For TextBox-based headings, you can modify the Control Source to display values from the underlying table or query fields. This allows the heading text to change dynamically as you navigate between records on your data editing form.
Tip: You may omit the second parameter when calling the function if you only need a Label-based 3D heading.
Downloads
Download Demo Database
plz send this software to e mail id
ReplyDeleteYou can Download a Demo Database from the Link given at the bottom of the Article.
ReplyDelete