Adding a Hyper-link using the lable control

This API code will add a hyperlink to your app. Add a textbox(text1) and label(label1)

================================================================

Option Explicit

Private Const clrLinkActive = vbBlue
Private Const clrLinkHot = vbRed
Private Const clrLinkInactive = vbBlack

Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Private Declare Function ScreenToClient Lib "user32" _
(ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Private Sub Form_Load()

Text1.Text = Text1
Label1.AutoSize = True

End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Label1
.ForeColor = clrLinkInactive
.FontUnderline = False
End With
End Sub

Private Sub label1_Click()
Dim sURL As String

'open the URL using the default browser
sURL = Label1.Caption

Call RunShellExecute("open", sURL, 0&, 0&, SW_SHOWNORMAL)

End Sub


Private Sub RunShellExecute(sTopic As String, sFile As Variant, _
sParams As Variant, sDirectory As Variant, nShowCmd As Long)

'execute the passed operation, passing
'the desktop as the window to receive
'any error messages
Call ShellExecute(GetDesktopWindow(), _
sTopic, _
sFile, _
sParams, _
sDirectory, _
nShowCmd)

End Sub


Private Sub Text1_Change()
'reflect changes to the textbox
Label1.Caption = Text1.Text

End Sub

Private Sub Text1_GotFocus()
Dim pos As String

'if the textbox has the URL double
'slashes, select only the text after
'them for editing convenience
pos = InStr(Text1.Text, "//")

If pos Then

With Text1
.SelStart = pos + 1
.SelLength = Len(.Text)
End With

End If
End Sub


Private Sub label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

With Label1

.ForeColor = clrLinkActive
.FontUnderline = True

End With
End Sub