'Constants
Private Const HYPERLINK_HIGHLIGHT As Long = vbYellow
Private Const HYPERLINK_COLOUR As Long = vbBlue
'Hyperlink code selection flag
Private flgHyperLinkSelected As Boolean
'Depress textbox hyperlink
Public Sub LinkDown(txtLink As TextBox)
'Remove focus from text box
HideCaret txtLink.hwnd
'Change label to selected colour
txtLink.ForeColor = HYPERLINK_HIGHLIGHT
'Enable option selected flag
flgHyperLinkSelected = True
'Remove focus from text box
HideCaret txtLink.hwnd
End Sub
'Highlight textbox hyperlink
Public Sub LinkOver(txtLink As TextBox, X As Single, Y As Single)
'Show highlight image when mouse moves over link text
If Not (flgHyperLinkSelected) Then
With txtLink
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
'Release picture handle
ReleaseCapture
'Unhighlight incident code
txtLink.FontUnderline = True
txtLink.ForeColor = HYPERLINK_COLOUR
Else
'Capture label handle
SetCapture .hwnd
'Highlight incident code
txtLink.FontUnderline = False
txtLink.ForeColor = HYPERLINK_HIGHLIGHT
End If
End With
End If
'Remove focus from text box
HideCaret txtLink.hwnd
End Sub
'Click textbox hyperlink
Public Sub LinkUp(txtLink As TextBox, X As Single, Y As Single, objActionObj As Object, strActionFunc As String, Optional varArgs As Variant)
'Remove focus from text box
HideCaret txtLink.hwnd
'Check mouse location
If (X > 0 And X < txtLink.Width) And (Y > 0 And Y < txtLink.Height) Then
'Call action function
CallByName objActionObj, strActionFunc, VbMethod, varArgs
End If
'Disable selected flag
flgHyperLinkSelected = False
'Release label handle
ReleaseCapture
'Unhighlight incident code
txtLink.FontUnderline = True
txtLink.ForeColor = HYPERLINK_COLOUR
'Remove focus from text box
HideCaret txtLink.hwnd
End Sub