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" _
   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 = "http://vbnet.mvps.org/"
    
  'position the label within the pixbox
  'and resize the pixbox to the label size
   With Label1
      
     .Move 0, 0
     .ForeColor = clrLinkInactive
      Picture1.Move Picture1.Left, _
                        Picture1.Top, _
                        .Width, .Height
   End With
    
End Sub


Private Sub Text1_Change()

  'reflect changes to the textbox
   Label1.Caption = Text1.Text
   
  'because the label is set to AutoSize,
  'the effective area of the picturebox
  'needs to be changed as well
   Picture1.Move Picture1.Left, _
                     Picture1.Top, _
                     Label1.Width, _
                     Label1.Height
   
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 Timer1_Timer()

   Dim pt As POINTAPI
   Dim x As Long
   Dim y As Long
    
  'determine if the cursor is still over
  'the pixbox containing the link label
   With Picture1
       
      GetCursorPos pt
      ScreenToClient .hwnd, pt
      
      x = pt.x * Screen.TwipsPerPixelX
      y = pt.y * Screen.TwipsPerPixelY
      
      If (x < 0) Or (x > .Width) Or _
         (y < 0) Or (y > .Height) Then
         
           'the cursor has moved outside, so
           'reset the label appearance
            Label1.ForeColor = clrLinkInactive
            Label1.Font.Underline = False
            
           'and disable the timer
            Timer1.Enabled = False
            
      End If
   
   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 Label1_MouseDown(Button As Integer, _
                             Shift As Integer, _
                             x As Single, y As Single)

  'when the label is clicked, change
  'the colour to indicate it is hot
   With Label1
   
      If .ForeColor = clrLinkActive Then
         .ForeColor = clrLinkHot
         .Refresh
      End If
   
   End With

End Sub


Private Sub Label1_MouseUp(Button As Integer, _
                           Shift As Integer, _
                           x As Single, y As Single)

  'mouse released, so restore the label
  'to clrLinkActive
   With Label1
   
      If .ForeColor = clrLinkHot Then
         .ForeColor = clrLinkActive
         .Refresh
      End If
   
   End With
   
End Sub


Private Sub Label1_MouseMove(Button As Integer, _
                             Shift As Integer, _
                             x As Single, y As Single)
    
  'if not already highlighted, set the
  'label colour and start the timer to
  'poll for the mouse cursor position
   With Label1
   
      If .ForeColor = clrLinkInactive Then
         .ForeColor = clrLinkActive
         .Font.Underline = True
         Timer1.Interval = 100
         Timer1.Enabled = True
      End If
   
   End With
   
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