Highlighting Controls

[Mark Gambo]

Here is something I wrote for a friend of mine and I figured I would share it. This code snippet will highlight most controls when they receive the focus. It can be further customized. See attached image.

Here is the code:

Option Explicit
'In a Module
 
Public Sub GotFocusFunct(ByVal NameObj As Object, _
                         ByVal lngIndex As Long, _
                         ByVal ShapeObj As Shape)
On Error GoTo ErrHandler
    With NameObj.Item(lngIndex)
        ShapeObj.Move .Left - 50, .Top - 50, _
                    .Width + 100, .Height + 100
        .BackColor = vbYellow
        .SelStart = 0
        .SelLength = Len(.Text)
        ShapeObj.Visible = True
    End With
Exit Sub
 
ErrHandler:
    If Err.Number = 438 Then
        Resume Next 'Handles error when trying to
                    'select the text or change BackColor
                    'of a control that doesn't have that
                    'property
    Else
        MsgBox Err.Number & " - " & Err.Description & " in Module1"
    End If
End Sub
 
Public Sub LostFocusFunct(ByVal NameObj As Object, _
                          ByVal lngIndex As Long, _
                          ByVal ShapeObj As Shape)
    With NameObj.Item(lngIndex)
        ShapeObj.Visible = False
        .BackColor = vbWhite
    End With
End Sub

and then you put the following code in the GotFocus and LostFocus Events:

Option Explicit
'On the Form
 
Private Sub Text1_GotFocus(Index As Integer)
    Call GotFocusFunct(Text1, Index, Shape1)
End Sub
 
Private Sub Text1_LostFocus(Index As Integer)
    Call LostFocusFunct(Text1, Index, Shape1)
End Sub

Note each control that you use this code with has to have a value entered into it Index property in order for this code to work. It works great with Control Arrays. Additionally, you must add a Shape1 rectangle object to the form.

[|2eM!x]

i forgot to say it, but it looks like a real nice piece of code!

[Mark Gambo]

Thanks for your comments

[|2eM!x]

just as a nice idea:

Public Sub GotFocusFunct(ByVal NameObj As Object, _
                         ByVal lngIndex As Long, _
                         ByVal ShapeObj As Shape, _
                        [B] ByVal ObjColor as Long[/B])
On Error GoTo ErrHandler
    With NameObj.Item(lngIndex)
        ShapeObj.Move .Left - 50, .Top - 50, _
                    .Width + 100, .Height + 100
        [B].BackColor = ObjColor[/B]
        .SelStart = 0
        .SelLength = Len(.Text)
        ShapeObj.Visible = True
    End With
Exit Sub

just for added flexibility...i know its easy but

[Mark Gambo]

Yeah this code can be expanded to do almost anything. Nice code BTW.