Hyperlinks in VB

[rjlohan]

I just whipped this up, thought it may be of use to people. add this code to a module, and you have the full functionality of a hyperlink in VB. Does display changes for MouseOver etc. Pass the LinkUp the function you want to call for the particular textbox 'link' and you're away. Have fun.

'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

To use:

Private Sub Text1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Press link
    Call LinkDown(Text1(Index))
End Sub
 
Private Sub Text1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Highlight link
    Call LinkOver(Text1(Index), X, Y)
End Sub
 
Private Sub Text1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Call LinkUp when mouse up on textbox
    Call LinkUp(Text1(Index), X, Y, frmLesson, "FunctionName", Index)
End Sub