Categories: MSDN / DotNet / Java / Scripts / Linux / PHP Ask - La ask - La Answer

GUI in VB6

I've got the following three questions:

1. Is it possible to build hyperlinks in GUI using VB6.

2. How to highlight some words displayed in a label or textbox?

3. How to measure the time spent in executing the programme and display it in "hour:minute:second" format to the user.

Thanks very much.
[337 byte] By [WXY595] at [2007-11-11 8:07:06]
# 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 >
# 2 Re: GUI in VB6
2) You can use the .SelStart and .SelLength properties of the TextBox to highlight text. You can't highlight in a listbox.

1) There are some good third-party controls to do hyperlinks. Some free, some you pay for.
edburdo at 2007-11-11 17:26:58 >
# 3 Re: GUI in VB6
If you need more highlighting than selecting a single range of characters, you should use a RichTextBox control, which supports multiple fonts, styles and colors.
Phil Weber at 2007-11-11 17:27:57 >
# 4 Re: GUI in VB6
3. How to measure the time spent in executing the programme and display it in "hour:minute:second" format to the user.

Option Explicit

Private m_time As Date

Private Sub Form_Load()
m_time = Now
Timer1.Interval = 1000
Timer1.Enabled = True
Label1.Caption = "00:00:00"
End Sub

Private Sub Timer1_Timer()
Dim t As Long
t = DateDiff("s", m_time, Now)
Dim s As Long
Dim m As Long
Dim h As Long
s = t Mod 60
t = t \ 60
m = t Mod 60
t = t \ 60
h = t
Label1.Caption = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
End Sub
mstraf at 2007-11-11 17:29:02 >
# 5 Re: GUI in VB6
I would like to thank you all. You are very helpful.
WXY595 at 2007-11-11 17:30:03 >