Border2D Heading Text ~ LEARN MS-ACCESS TIPS AND TRICKS

Introduction.

MS-Access Form/Report Design Tools are very easy to use and need only some practice to master them. But creating controls like the image given above manually is very difficult, but it can be done manually too. You can do it with five identical labels by arranging one over the other, the topmost one with font color red and others in white. The four labels with white color must be moved, each one about one-pixel distance, to four corners of the topmost label with red color.

The Sample Report Title image is given below:

But, arranging all the labels properly in the right places, without distortion of the style, is not that easy to do manually. The above red-colored (you can customize the color later) heading text with white borders can be created in seconds with the user-defined Function given below, by automating the technique I have explained above.

Automating Text Styling

Copy and Paste the VBA Code given below into a new Global Module in your database. If you have already copied the first three functions (Function names given below) and the Global Declarations from the earlier Post: Create 3D Headings on Forms then Copy and Paste the last Function Border2D only.

The following common functions are used for all 2D/3D styles:

FormTxtLabels()
Validate_Dup()
MsgLabel()

If you have already copied them earlier then copy only the last Function: Border2D()

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 Border2D(ByVal intForeColor As Integer, _
ByVal intBorderColor As Integer, Optional ByVal Label0Text1 As Integer) As String
'------------------------------------------------------------  
'Author : a.p.r. pillai  
'Date : September 2006  
'------------------------------------------------------------
Dim intlbls As Integer  
Dim j As Integer, ForeColor As Long, BorderColor As Long  
Dim lblName() As String, X As Integer, mySection As Section  
Dim l As Long, t As Long, intFSize As Integer
On Error Resume Next
  
Border2D = FormTxtLabels(Label0Text1)  
Set mySection = MyFrm.Section(acDetail)  
intlbls = mySection.Controls.Count - 1  
On Error GoTo Border2D_Err  
X = Validate_Dup(MyFrm, 5) ' check type and duplicate  
If X = 1 Then  
     Exit Function  
End If  
intlbls = mySection.Controls.Count - 1  
X = intForeColor  
intForeColor = IIf(X < 0, 0, IIf(X > 15, 15, intForeColor))  
X = intBorderColor  
intBorderColor = IIf(X < 0, 0, IIf(X > 15, 15, intBorderColor))
  
ReDim lblName(0 To intlbls) As String  

ForeColor = QBColor(intForeColor)   
BorderColor = QBColor(intBorderColor)    
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   
End With   
Next    
mySection.Controls(lblName(intlbls))
    .ForeColor = ForeColor    
For j = 0 To intlbls - 1   
     mySection.Controls(lblName(j)).ForeColor = BorderColor   
Next    
l = intX: t = intY    
With mySection.Controls(lblName(4))   
    .Left = l   
    .Top = t   
End With    
For j = 0 To intlbls - 1   
With mySection.Controls(lblName(j))   
If j = 0 Or j = 3 Then  .Left = l - LngI    
If j = 1 Or j = 2 Then  .Left = l + LngI    
If j = 0 Or j = 1 Then .Top = t    
If j = 1 Then .Top = t - (0.0104 * 1440)    
If j = 0 Then .Top = t + (0.0104 * 1440)    
If j = 2 Then .Top = t + LngI    
If j = 3 Then .Top = t - LngI    
End With   
Next   
MsgLabel    
Border2D_Exit:   
Exit Function    

Border2D_Err:   
MsgBox Err.Description,, "Border2D"   
Resume Border2D_Exit   
End Function

Note: Before running this function ensure that the essential Library files, which I have mentioned in my earlier Article Command-Button Animation, are all linked to your Project. The main programs given under the topic Create 3D-Headings on Forms are also required here. Copy and Paste those programs into a global module in your project, if it is not already done earlier.

The above function will create a new form and will design the heading text on it in seconds. You can copy & paste it anywhere on Forms or Reports you like and customize it with the required text, text size, color, and text in bold or italics.

How to Run the Code Manually.

Open the VBA Module Window (if not already open) by pressing Alt+F11 then press Ctrl+G to open the Immediate Window (Debug window).

Command Syntax:

Border2D TextForeColor, TextBorderColor, Label, or Text

Type the following and press the Enter key in the Debug Window:

Border2D 4,15,0

If you prefer to run the program with a Command Button Click Event Procedure, then you must use text boxes on the Form to set the parameter values of the function and use references of the text boxes in command parameters.

Example:

Private Sub cmdBorder2D_Click()
   Border2D Me![txtForeColor], Me![txtBorderColor],0
End Sub

The first two Parameter values are for Text Fore-Color and Border Color respectively (Value Range is 0 to 15). The 3^rd parameter value 0 will create a Label based design and 1 will create a textbox-based design. The third parameter value is optional, when omitted, it will create a Label based design by default.

QBColor	Description	QBColor	Description
0	Black	8	Gray
1	Blue	9	Light Blue
2	Green	10	Light Green
3	Cyan	11	Light Cyan
4	Red	12	Light Red
5	Magenta	13	Light Magenta
6	Yellow	14	Light Yellow
7	White	15	Bright White

The Module Window will flash a little as if it is refreshed. Minimize the module window (with Alt+F11 you can toggle the window) to show up the database window and you will see a new form is created with the name Form1 and the Border2D heading is created with a white border.

Customizing Text Properties.

Once the Heading is created you can change text, text size, forecolor, border color and change the style to bold, italic, etc.

To change the Heading Text, Text Style, Border Color, and Text Color:

Select all the controls together and display the Property Sheet and change the Caption with the text of your choice. While all the labels are in the selected state you can make the text Bold, Italic, or change the size of the text. Select a color from the color palette for the border first. This will change the fore-color of all Labels. Now, click only on the top Label and apply a different foreground color.