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


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

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

 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 = ""
  '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, _
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
      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
      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, _

End Sub
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