# 1 Re: GUI in VB6
>>Is it possible to build hyperlinks in GUI using VB6.
>>How to highlight some words displayed in a label or textbox?
Yeah. It's possible. But it's not hyperlinks actually. you can coding in Label1_MouseMove() and Form_MouseMove(). maybe you can find the better way also..
Here is one sample.
Simulate a Hyperlink with a Label Control
http://vbnet.mvps.org/index.html?code/intrinsic/sehyperlink.htm
1) Create New Project.
2) Add one PictureBox
3) Add one Lable
4) Copy this lable and Paste it into PictureBox.
5) Open Properties of Label.
6) Set one cur to MouseIcon Property ( hand.cur )
7) Change the MousePointer to "99 - Custom"
8) Add TextBox ( to change the url )
9) Open Code and Paste the following code.
10) Run!
Option Explicit
''
' Copyright 1996-2006 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
>> 3. How to measure the time spent in executing the programme
I'm not sure i got u.
>>and display it in "hour:minute:second" format to the user.
You can use Format Function eg: Format(urTime, "hh:mm:ss").
Sync at 2007-11-11 17:25:59 >
