Demo shows how hyperlinks can be used in SCREEN 0 with hardware acceleration. Text can contain links anywhere and the routine will find them, underline them, and map them so they can be clicked.
Arrow up/down or mouse wheel to scroll 40 entries.
Arrow left/right to change right margin.
Click release follows a link (You need to undo the REM statement to shell it.)
Even if you reduce the margin so some links are only partially seen, you can still click to follow them.
The random demo text can easily be replaced with real text and links for a real application. I have one in the works that I am using the routines in this demo to complete.
Pete
Code: (Select All)
Width 120, 25: _Font 16
_ScreenMove 0, 0
Palette 7, 63: Color 0, 7: Cls: wide = _Width: tall = _Height
mt = 2: ml = 3: mr = wide - ml: mb = tall - 4
nol = mb + 1 - mt: ReDim map$(tall) ' Display 20 lines of text for this demo.
noe = 40: ReDim a$(noe) ' Total number of elements.
GoSub MakeUnderlineImage
GoSub border
GoSub MakeDemoText
GoSub disply ' Display the text/links to our screen.
Do
_Limit 60
GoSub underline
GoSub KeyboardMouse
If mw Then
mw = mw \ Abs(mw)
If mw < 0 And scr + mw > -1 Or mw > 0 And scr + nol < noe Then scr = scr + mw: GoSub disply
mw = 0
End If
If LinkActivate Then
If my > mb Then
Locate yla, xla: Color 1: Print ShowLink$;: Color 0
LinkActivate = 0
Else
If LinkActivate <> Asc(Mid$(map$(my), mx, 1)) Then
Locate yla, xla: Color 1: Print ShowLink$;: Color 0
LinkActivate = 0
End If
End If
End If
If my <= mb And lb <> 1 Then
If Mid$(map$(my), mx, 1) <> " " Then
_MouseShow "LINK"
If lb = 2 Or lb And LinkActivate = 0 Then
x$ = Mid$(map$(my), wide + 1)
seed = InStr(map$(my), Mid$(map$(my), mx, 1) + Chr$(4))
l = Val(Mid$(map$(my), InStr(seed, map$(my), "|") + 1))
temp$ = Mid$(map$(my), InStr(seed, map$(my), "[") + 1)
link$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)
ShowLink$ = Mid$(link$, InStr(link$, "://") + 3, l)
If InStr(x$, "https://") Then k = 6 Else k = 5
Select Case lb
Case -1
If LinkActivate = 0 Then
yla = my: xla = Val(Mid$(map$(my), seed + 2))
Locate yla, xla: Color 4: Print ShowLink$;: Color 0
LinkActivate = Asc(Mid$(map$(my), mx, 1))
End If
Case 2
LinkActivate = 0: yla = 0: xla = 0
Locate my, Val(Mid$(map$(my), seed + 2)): Color 1: Print ShowLink$;: Color 0
Locate 24, 3: Print Space$(wide - 3);
Locate 24, 3: Print "Follow: " + link$;
Rem Shell _Hide _DontWait link$
Case Else
If LinkActivate Then LinkActivate = 0: yla = 0: xla = 0
_MouseShow "DEFAULT"
End Select
End If
Else
_MouseShow "DEFAULT"
End If
Else
If LinkActivate Then _MouseShow "LINK" Else _MouseShow "DEFAULT"
End If
_Display
Loop
MakeUnderlineImage:
j = wide: fw = _FontWidth: fh = _FontHeight
CRed = 0: CGrn = 0: CBlu = 155
t = _NewImage((j + 1) * fw, 2 * fh, 32)
_Dest t
Line (0, fh * 1 - 3)-(j * fw, fh * 1 - 3), _RGB32(CRed, CGrn, CBlu), B
lin = _CopyImage(t, 33)
_FreeImage t
_Dest 0
Return
border:
View Print mt - 1 To mb + 1: Cls 2: View Print
Locate mt - 1, ml - 1: Print String$(mr - 2, Chr$(196));
Locate mb + 1, ml - 1: Print String$(mr - 2, Chr$(196));
For i = 1 To mb - 1: Locate mt - 1 + i, ml - 1: Print Chr$(179);: Locate , mr - 1: Print Chr$(179);: Next
Locate mt - 1, ml - 1: Print Chr$(218);: Locate mt - 1, mr - 1: Print Chr$(191);
Locate mb + 1, ml - 1: Print Chr$(192);: Locate mb + 1, mr - 1: Print Chr$(217);
Return
MakeDemoText:
For i = 1 To nol * 2 ' Let's make twice as many lines of hypertext displayed so we can scroll.
q$ = ""
For dup = 1 To 2 ' Let's make two hypertext links per line.
x1$ = "" ' Make some text.
For j = 1 To Int(Rnd * nol)
If Int(Rnd * 5) = 1 Then
x1$ = RTrim$(x1$) + " "
Else
x1$ = x1$ + Chr$(Int(Rnd * 26) + 97)
End If
Next
x2$ = "" ' Make a hyperlink.
If Int(Rnd * 2) = 1 Then a$ = " http://" Else a$ = " https://"
For j = 1 To Int(Rnd * 17) + 5
x2$ = x2$ + Chr$(Int(Rnd * 26) + 97)
Next
x3$ = "" ' Make some more text after the link.
For j = 1 To Int(Rnd * nol)
If Int(Rnd * 5) = 1 And Len(x3$) Then
x3$ = RTrim$(x3$) + " "
Else
x3$ = x3$ + Chr$(Int(Rnd * 26) + 97)
End If
Next
q$ = q$ + _Trim$(x1$) + a$ + x2$ + ".com " + RTrim$(x3$): If dup = 1 Then q$ = q$ + " "
Next
cntr$ = "0" + LTrim$(Str$(i)): If Len(cntr$) > 2 Then cntr$ = Mid$(cntr$, 2)
a$(i) = cntr$ + " " + _Trim$(q$) ' Store the line is our array.
Next
Return
disply:
y = CsrLin: x = Pos(0): ReDim map$(tall): entry = 0: PageLen = mr - ml - 1
For d = mt To mb
Locate d, ml: Print Space$(wide - ml - (wide - mr + 1));: Locate d, ml
seed = 1: cnt = 0: entry = entry + 1: TextLen = 0
Do
temp$ = a$(entry + scr)
If InStr(seed, temp$, "://") Then
cnt = cnt + 1: If map$(d) = "" Then map$(d) = Space$(wide)
j = InStr(seed, temp$, "://")
x$ = LCase$(Mid$(temp$, seed, j - seed + 1))
If Right$(x$, 6) = "https:" Then k = 6: http$ = "https://" Else k = 5: http$ = "http://"
a$ = Mid$(temp$, seed, j - k - (seed - 1)): TextLen = TextLen + Len(a$)
l = InStr(Mid$(temp$, j + 3) + " ", " ") - 1
Locate d: Color 0
h1 = Pos(0)
If TextLen <= PageLen Then Print a$; Else Print Mid$(a$, 1, mr - h1 - 1);
a$ = Mid$(temp$, j + 3, l) + " ": seed = j + 2 + Len(a$) + 1
Rem l = l + k + 2: a$ = Mid$(temp$, j - k + 1, l) + " " 
eed = j - k + Len(a$) + 1 ' Use this instead of above to include http.
h1 = Pos(0): TextLen = TextLen + Len(a$): Color 1 ' Our link.
If TextLen <= PageLen Then
Mid$(map$(d), h1, l) = String$(l, Chr$(32 + cnt))
map$(d) = map$(d) + Chr$(32 + cnt) + Chr$(4) + LTrim$(Str$(h1)) + "|" + LTrim$(Str$(l)) + "[" + http$ + _Trim$(a$) + "],"
Print a$;
Else ' Cut off what's past the right margin.
l = mr - h1 - 1: Mid$(map$(d), h1, l) = String$(l, Chr$(32 + cnt))
map$(d) = map$(d) + Chr$(32 + cnt) + Chr$(4) + LTrim$(Str$(h1)) + "|" + LTrim$(Str$(l)) + "[" + http$ + _Trim$(a$) + "],"
Print Mid$(a$, 1, l);
End If
Else
If seed > 1 Then a$ = Mid$(temp$, seed)
Color 0: TextLen = TextLen + Len(a$)
h1 = Pos(0)
If TextLen <= PageLen Then Print a$; Else Print Mid$(a$, 1, mr - h1 - 1);
Exit Do
End If
Loop
Next
Locate y, x
Return
underline:
y = CsrLin: x = Pos(0)
For i = mt To mt + nol
x$ = Mid$(map$(i), wide + 1)
If Len(LTrim$(x$)) Then
seed = 1
Do
h1 = Val(Mid$(x$, seed + 2))
l = Val(Mid$(x$, InStr(seed, x$, "|") + 1))
_PutImage ((h1 - 1) * fw, (i - 1) * fh), lin, , ((h1 - 1) * fw, 0)-(((h1 - 1) + l) * fw, fh)
seed = InStr(seed + 1, x$, ",") + 1
Loop Until seed = 1
End If
Next
Locate y, x
Return
KeyboardMouse:
b$ = InKey$
If Len(b$) Then
Select Case b$
Case Chr$(27): System
Case Chr$(0) + "H": If scr > 0 Then scr = scr - 1: GoSub disply
Case Chr$(0) + "P": If scr + nol < noe Then scr = scr + 1: GoSub disply
Case Chr$(0) + "M": If mr < wide Then mr = mr + 1: GoSub border: GoSub disply
Case Chr$(0) + "K": If mr > ml + 1 Then mr = mr - 1: GoSub border: GoSub disply
End Select
End If
While _MouseInput
mw = mw + _MouseWheel
Wend
mx = _MouseX
my = _MouseY
If lb Then
If lb = 2 Then lb = _MouseButton(1) ' Left button click cycle completed and now neutral.
If lb = 1 And _MouseButton(1) = 0 Then lb = 2 ' Left button was released.
If lb = -1 Then lb = 1 ' Left button clicked and down.
Else
lb = _MouseButton(1)
End If
ReturnArrow up/down or mouse wheel to scroll 40 entries.
Arrow left/right to change right margin.
Click release follows a link (You need to undo the REM statement to shell it.)
Even if you reduce the margin so some links are only partially seen, you can still click to follow them.
The random demo text can easily be replaced with real text and links for a real application. I have one in the works that I am using the routines in this demo to complete.
Pete