Visual Basic Intrinsic Control Routines
ShellExecute: Simulate a Hyperlink with a Label Control
     
Posted:   Friday February 18, 2000
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   Matt Sargent, VBnet - Randy Birch
     

Related:  

Determining the Name of the Executable Associated with a Specific File
ShellExecute: ShellExecute Madness
CreateProcess: Start Separate Instances of the Default Browser

ShellExecute: Send Large Emails in Outlook Express
     
 Prerequisites
None.

By using a standard Label control, along side a picturebox and a couple of APIs, it is an easy step to simulate a typical hyperlink within a form. Typically this feature might be used to provide email or support via your application's About dialog. 

The code here is based on a newsgroup post by Matt Sargent. The key to this method's success in placement of the label inside a picturebox. In Matt's technique, because the VB label control does not expose a hwnd, Matt used a picturebox, sized to the label, to detect the rodent's cursor position in relation to the label it contained. When the API detected that the rodent had moved off link label, a timer, started when the link became 'active', reset the label's default properties. This mechanism gives the visual clue that the label will react as a HTML hyperlink would. In addition, code in the label's MouseDown and MouseUp events further toggle the hyperlink colour indicating the link was pressed.

The second illustration shows the layout positioning of the label within the picturebox. The only important positions are the initial left and top properties of the picturebox. Given these anchors, both the label and picturebox are resized in code to fit the link.

 BAS Module Code
None.

 Form Code
On a new form, add a timer (Timer1), and a textbox (Text1). Add a picturebox (Picture1) and set its BorderStyle to None. The illustration above shows the initial size of the pixbox (gold) ... its final size is established in code.

Once the pixbox has been set up, draw into it a label control (Label1). Set the label's AutoSize to True, its MousePointer property to 99 - Custom, and set its MouseIcon property to the finger cursor in this zip.  Change the three colour constants as desired in the general Declarations, and with these initial steps complete, add the following to the form:


Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
 Comments
This method is easily extended to send email as well, again using ShellExecute with the "mailto:" topic.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter