Hyperlink label

This code has been declared by its author to be Public Domain code.

Hyperlink label by Blaine

2005

Adds blue hyperlink labels to your BlitzPlus programs, which, when clicked, will execute the file specified.

Note: Requires "GetSystemColor()"'s functions and userlib addons, and "Change Cursor Icon"'s userlib addons.

Here's how you'll use the functions:
"CreateHyperlink( label$ , x , y , width , height , link$ , parent [, style] )

label$ - text to be displayed
x,y,width,height - position and size of hyperlink
link$ - file to execute when clicking. Can be a file, folder, or internet adress.
parent - parent gadget
style - this optional flag doesn't do anything.

Function will create a hyperlink label and return it's handle. The hyperlinks will black out when they get moved, but they should come back up right after. Also, they can have up to two lines of text (only happens if text is longer than size)."

"UpdateHyperlinks( )

Updates all hyperlink texts by keeping them displayed correctly, changing the mouse cursor, and executing the link. Needs to go in your main program loop, just before a WaitEvent() command."

Type hyperlink
Field canvas
Field href$
End Type


Function CreateHyperlink(txt$,x,y,w,h,link$,parent,style=0)
canvas=CreateCanvas(x,y,w,h,parent)
SetBuffer CanvasBuffer(canvas)
font=LoadFont("tahoma",13,0,0,1)
ClsColor getsyscolorr(15),getsyscolorg(15),getsyscolorb(15)
Cls
Color 0,0,255
SetFont font
If StringWidth(txt)>w
txt2$=txt
Repeat
txt2=Left(txt2,Len(txt2)-1)
Until StringWidth(txt2)<w
Text 0,0,txt2
Text 0,13,Right$(txt,Len(txt2)-3)
Else
Text 0,0,txt
EndIf
FlipCanvas canvas
l.hyperlink=New hyperlink
l\canvas=canvas
l\href=link
Return l\canvas
End Function


Function UpdateHyperlinks()
For l.hyperlink=Each hyperlink
If EventSource()=l\canvas
If EventID()=$203
SetCursor helpcursor
Else If EventID()=$201
ExecFile(l\href)
EndIf
EndIf
FlipCanvas l\canvas
Next
End Function

Comments

Artemis

2005

where do i find the getsyscolor and change cursor icon
userlibs
or in which dll are the in??

Blaine

2005

Alright, I'll just give them to you here:

Userlib additions:

.lib "user32.dll"
GetSysColor%(Color%):"GetSysColor"
LoadCursor%( ID, Cursor ):"LoadCursorA"
SetCursor%( ID ):"SetCursor"

Added functions:

Function GetSysColorR(SystemColor)
        Return (GetSysColor(SystemColor) And $000000FF) 
End Function

Function GetSysColorG(SystemColor)
	Return (GetSysColor(SystemColor) And $0000FF00) Shr 8
End Function

Function GetSysColorB(SystemColor)
	Return (GetSysColor(SystemColor) And $00FF0000) Shr 16 
End Function

Add those in and it should work.

Code Archives Forum