Post by mystic on Jul 11, 2019 13:11:28 GMT -5
In another thread I brought up it would be nice to have a LINK command in LB that would simulate an HTML link style.
Here is code I had apparently discovered a while back and saved. I apologize for not know who created it, but I can almost guarantee that I found it on the old message board someplace.
This code does what I would like, but it would just be nice to utilize a built in LB command rather then have to add this code any time I want to create this look and feel.
Maybe I'm just being lazy, but I think it would be a nice built-in feature for LB.
Here is code I had apparently discovered a while back and saved. I apologize for not know who created it, but I can almost guarantee that I found it on the old message board someplace.
This code does what I would like, but it would just be nice to utilize a built in LB command rather then have to add this code any time I want to create this look and feel.
Maybe I'm just being lazy, but I think it would be a nice built-in feature for LB.
[SetupWindow]
NoMainWin
WindowWidth = 400
WindowHeight = 200
UpperLeftX = Int((DisplayWidth-WindowWidth)/2)
UpperLeftY = Int((DisplayHeight-WindowHeight)/2)
Link1.Width = 80
Link1.Height = 26
GraphicBox #Win.Link1, 4, 4, Link1.Width, Link1.Height
Stylebits #Win.Link1, 0, _WS_BORDER, 0, 0
Open "Hyperlink Custom Control" For Window As #Win
#Win, "TrapClose [Quit.Win]"
Link1$ = cCc.Hyperlink$("#Win.Link1", Link1.Width, Link1.Height, "Link 1 Text", _
"Arial 10", "buttonface", "blue", "[Link1.Click]", "[Link1.Move]")
Wait
[Quit.Win]
Close #Win
End
[Link1.Click]
Notice "You clicked Link 1."
Wait
[Link1.Move]
Call cC.RollHyperlink Link1$, MouseX, MouseY
Wait
Function cCc.Hyperlink$(gbHndl$, width, height, text$, font$, backcolor$, linkcolor$, eventClick$, eventMove$)
#gbHndl$, "CLS; Down; Fill ";backcolor$ 'Clear the graphicbox and fill it with the specified backcolor.
'We need the height of the current font in pixels. Here's an easy way:
#gbHndl$, "Place -100 -100 " 'Place pen offscreen
#gbHndl$, "| " 'Print a blank line.
#gbHndl$, "PosXY penX penY" 'Get the coordinates of the pen. After drawing text, the pen moves down the proper
'height to make room for another line. Just subtract the end position from the start position to get the height
'of the font:
fontHeight = penY-(-100) 'And it works, if you print the results out!
'--------------------------------------------------------------------'
#gbHndl$, "CLS; Down; Fill ";backcolor$;"; Flush" 'Redo the intial thing just in case and this time flush it
'so the graphics will stick.
#gbHndl$, "Font ";font$;" ; Color ";linkcolor$;" ; BackColor ";backcolor$ 'Set the font, foreground and background
'color.
'While we're at it, let's get the width of the string (so we can center our text in the graphicbox!):
#gbHndl$, "StringWidth? text$ stringWidth"
'Calculate the x coordinate for text placement:
Xcoord = Int((width-stringWidth)/2)
'--------------------------------------------------------------------'
#gbHndl$, "Place ";Xcoord;" ";fontHeight+2 'Set the pen at the proper location so the text will draw correctly
'in the graphicbox.
'Notice the text will start at the far left of the gbox, just like statictext would.
#gbHndl$, "|"; text$ 'Draw the text!
#gbHndl$, "Flush DefaultText" 'Make this drawing stick. And, give this drawing (segment) the name DefaultText .
#gbHndl$, "when leftButtonUp "; eventClick$ 'Set the graphicbox to jump to the branch label/sub that the user
'specified when the link/graphicbox is clicked.
#gbHndl$, "when mouseMove "; eventMove$
'Now, return the handle to a hyperlink so the user can pass it to the hyperlink functions:
hlinkActive = 0 'The hyperlink isn't active just yet.
'Return all the info as one big string of data seperated by spaces. We'll parse this using word$() in another
'function. This allows the user to have more or less a "handle" to a link.
font$ = Sys.ReplaceChar$(font$," ","ø") 'Replace any spaces in the font text with a weird symbol, so we can parse the
'handle with word$() in another function.
text$ = Sys.ReplaceChar$(text$," ","ø") 'Do the same with the text of the hyperlink. We'll reverse this in the other
'function using Sys.ReplaceChar$(text$,"_"," ") which will replace the underscores with spaces - so we'll be back
'to normal. Same with the font$.
cCc.Hyperlink$=gbHndl$;" ";width;" ";height;" ";hlinkActive;" ";font$;" ";backcolor$;" ";linkcolor$;" ";_
eventClick$;" ";eventMove$;" ";text$;" ";fontHeight
'Word 1 = handle to the graphicbox.
'Word 2 = the width of the graphicbox
'Word 3 = the height of the graphicbox.
'Word 4 = 0/1 - whether or not the link is active (mouse over) hlinkActive
'Word 5 = the font used
'Word 6 = the backcolor
'Word 7 = the link color
'Word 8 = the event in which to trigger when the link is clicked.
'Word 9 = the event in which to trigger when the mouse is moved over the gbox.
'Word 10 = the text for the hyperlink
'Word 11 = the height of the font
End Function
Sub cC.RollHyperlink byref Link$, X, Y
'Extract information from the hyperlink's handle:
gbHndl$ = Word$(Link$,1) : width = Val(Word$(Link$,2)) : height = Val(Word$(Link$,3))
hlinkActive = Val(Word$(Link$,4)) : font$ = Word$(Link$,5) : backcolor$ = Word$(Link$,6)
linkcolor$ = Word$(Link$,7) : eventClick$ = Word$(Link$,8) : eventMove$ = Word$(Link$,9)
text$ = Word$(Link$,10) : fontHeight = Val(Word$(Link$,11))
#gbHndl$, "Font ";font$;" ; Color ";linkcolor$;" ; BackColor ";backcolor$ 'Make sure the colors and fonts are set
'right...
'Now, replace the weird symbol in the font$ and text$ with spaces:
font$ = Sys.ReplaceChar$(font$,"ø"," ")
text$ = Sys.ReplaceChar$(text$,"ø"," ")
'Recalculate the width of the text for placement's sake:
#gbHndl$, "StringWidth? text$ stringWidth"
'Calculate the x coordinate for text placement:
Xcoord = Int((width-stringWidth)/2)
'--------------------------------------------------------------------'
'Check to see if the mouse coordinates (X, Y) are over the link's text - if so, we'll make sure the hyperlink
'becomes underlined:
'First, let's get the width of the hyperlink's text using the stringwidth? command:
#gbHndl$, "StringWidth? text$ textWidth"
textWidth = textWidth + 1
'Now, we know both the width and height of the text. they are stored in textWidth and fontHeight . Perfect!
'Now, check to see if the mouse is over the actual area the text is drawn in:
If X<=(textWidth+Xcoord) And X>=Xcoord And Y<=(fontHeight+2) And Y>=2 Then 'If the mouse is in the proper area:
If Not(hlinkActive) Then
'If the link has not been drawn in it's mouseOver (active) state, then let's do so now.
'If hlinkActive was true (set to 1),
'it means we had already drawn it in it's active state, so we wouldn't need to redraw the same thing.
'That just causes flickering.
#gbHndl$, "DELSEGMENT DefaultText" 'Delete the inactive (normal) drawing of the text.
#gbHndl$, "REDRAW" 'Update the graphicbox to reflect our deletion.
#gbHndl$, "Place ";Xcoord;" ";fontHeight+2 'Position the pen to redraw the text.
#gbHndl$, "Font ";font$;" underscore" 'Set the font to be underlined! Of course,
'if the user already has an underlined font, this is a bummer. :(
#gbHndl$, "|";text$ 'Draw the new, underlined text!
#gbHndl$, "Flush ActiveText" 'Make this drawing stick, and call it ActiveText -
'we can remove this drawing and redraw the old one when the mouse isn't
'over the graphicbox text area. Cool, huh?
hlinkActive = 1 'The hyperlink is now in it's active state!
End If
Else 'If the mouse is NOT over the actual text area, then let's make sure that the hyperlink is drawn in it's
'inactive state.
If hlinkActive Then 'If the hyperlink is being drawn in it's active state, then let's unactivate it!
#gbHndl$, "DELSEGMENT ActiveText" 'Remove the drawing of the active text.
'Draw the text in it's normal state:
#gbHndl$, "REDRAW"
#gbHndl$, "Font ";font$
#gbHndl$, "Place ";Xcoord;" ";fontHeight+2
#gbHndl$, "|";text$
#gbHndl$, "Flush DefaultText" 'Make it stick and call this drawing the DefaultText drawing.
hlinkActive = 0 'hlinkActive is now inactive.
End If
End If
'----------------------------------------------------------------------------'
'Replace spaces with underscores...
font$ = Sys.ReplaceChar$(font$," ","ø")
text$ = Sys.ReplaceChar$(text$," ","ø")
'Change the properties of the hyperlink's handle to match the updated properties.
'This will actually affect the user's handle, because we passed Link$ by reference. (byref in the help file)
Link$=gbHndl$;" ";width;" ";height;" ";hlinkActive;" ";font$;" ";backcolor$;" ";linkcolor$;" ";_
eventClick$;" ";eventMove$;" ";text$;" ";fontHeight
End Sub
'This is a helper function for the hyperlink functions.
Function Sys.ReplaceChar$(String$, FindChar$, ReplaceChar$) 'Find the character FindChar$ and replace
'it with ReplaceChar$
For i = 1 To Len(String$)
char$=Mid$(String$,i,1)
If char$=FindChar$ Then char$=ReplaceChar$
Sys.ReplaceChar$=Sys.ReplaceChar$;char$
Next i
End Function
