Sorry I wasn't around for a few days to beat the dead horse. I was busy buying a bigger club... and know, on with the horse beating!!!
Code: (Select All)
REM This demo reads html text for color and hyperlink tags, only. See x$. The screen displays the results without
REM the tags, and will be word wrapped, if the right margin changes, by using the arrow right and left keys or
REM resizing with a mouse drag at the right side of the screen.
$Resize:On
Do: Loop Until _Resize = 0
Type mousevar
mx As Integer ' Row.
my As Integer ' Column.
wh As Integer ' Wheel.
lb As Integer ' Left Button.
rb As Integer ' Right Button.
lb_status As Integer ' Left Button Status.
rb_status As Integer ' Right Button Status.
CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
Palette 7, 63
Palette 4, 52
Palette 1, 17
Palette 2, 42
Palette 0, 56
Color 0, 7
Width 80, 25
Cls
fsize = 20
font& = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", fsize, "monospace")
If font& <= 0 Then _Font 16 Else _Font font&
_Delay 1
_ScreenMove _Middle
ReDim id(_Height, _Width) As Integer
ReDim linelength(_Height) As Integer
ReDim linkmap(_Height) As String
w = 80: rswidth = 80
x$ = "This is an example of a way to include <span style=" + Chr$(34) + "color: rgb(153, 0, 0);" + Chr$(34) + ">color</span> and hypertext in a "
x$ = x$ + "<span style=" + Chr$(34) + "color: rgb(0, 102, 0);" + Chr$(34) + ">SCREEN 0</span> text word wrap simulation. Let's go to <a href=" + Chr$(34) + "https://duckduckgo.com" + Chr$(34) + ">DuckDuckGo!</a> Okay, how about <a href=" + Chr$(34) + "https://qb64phoenix.com" + Chr$(34) + ">QB64Phoenix?</a> Maybe try <a href=" + Chr$(34) + "https://www.tapatalk.com/groups/qbasic/" + Chr$(34) + ">The QBASIC Forum!</a>"
instructions$ = "Press Arrow Lt/Rt Keys to Change Rt. Margin."
Locate 2, _Width \ 2 - Len(instructions$) \ 2
Print instructions$;
View Print 4 To _Height - 1
Do
Cls 2
If w < _Width Then ' Display right margin bar when width is less than 80.
For i = 4 To _Height - 2: Locate i, w + 1: Print Chr$(179);: Next
End If
GoSub zero_variables
Locate 4, 1
Do
i% = i% + 1
c$ = Mid$(x$, i%, 1)
Select Case c$
Case "<" ' Strips out entire front tag.
If Mid$(x$, i%, 2) <> "</" Then
j% = InStr(Mid$(x$, i%), ">") ' Length of front tag.
parse$ = Mid$(x$, i%, j%) ' Front tag.
If InStr(LCase$(parse$), "153, 0, 0") Then tag$ = "red"
If InStr(LCase$(parse$), "0, 102, 0") Then tag$ = "green"
If InStr(LCase$(parse$), "href") Then tag$ = "link"
i% = i% + j% - 1 ' Advances text reader past then front tag on next read.
If InStr(LCase$(parse$), "153, 0, 0") Then tag$ = "red"
If InStr(LCase$(parse$), "0, 102, 0") Then tag$ = "green"
If InStr(LCase$(parse$), "href") Then tag$ = "link"
Select Case tag$
Case "red": Color 4
Case "green": Color 2
Case "link": Color 1
End Select
Else ' End tag
j% = InStr(Mid$(x$, i%), ">") ' Length of end tag.
i% = i% + j% - 1 ' Advances text reader past then end tag on next read.
GoSub default_variables ' Tag event is over so reset the variables.
End If
_Continue ' Nothing to display, so continue loop.
Case " "
flag = 1 ' Find the length of the upcoming word after any front tag is processed.
r% = 1 ' The r% variables is a wrap evaluator. It provides the length of the next word or character like a single-letter word or space.
Case Else ' Non-space character.
If flag Then
flag = 0
chop$ = Mid$(x$, i%, InStr(Mid$(x$ + " ", i%), " ") - 1)
r% = InStr(chop$ + "</", "</") - 1 ' Number of characters enclosed in a tag.
Else
r% = 1 ' Default value.
End If
End Select
If col% + r% > w Then ' Wrap.
If row% = _Height - 2 Then Exit Do ' At bottom margin so can't advance.
If col% > 0 Then ' Advance row unless word being printed at left margin is longer than the line width.
row% = row% + 1: col% = 0
End If
End If
col% = col% + 1
Locate row%, col%
If w > 1 Then
If c$ <> " " Then ' Non-Space.
GoSub displayit
Else ' Space.
If col% = 1 Then col% = 0 ' Ignore leading space.
cc = cc + 1
End If
Else ' For vertical 1-column displays, only.
GoSub displayit ' Preserves spaces for a single column vertical display.
End If
If tag$ = "link" Then Mid$(linkmap(CsrLin), col%, 1) = String$(1, "*") ' Map the screen to find the link.
Loop Until i% >= Len(x$)
linelength(row%) = col% - 1 ' Set the bottom margin text character count.
col% = 0: cc = 0: flag = 0
GoSub default_variables
Do
_Limit 60
mouse m
If m.lb_status = 1 Then
If m.CursorStyle = 1 Then ' Follow link.
parse$ = Mid$(x$, 1, id(m.my, m.mx))
parse$ = Mid$(parse$, _InStrRev(parse$, "href=") + 6)
url$ = Mid$(parse$, 1, InStr(parse$, Chr$(34)) - 1)
Shell _DontWait url$
End If
End If
If m.mx <= linelength(m.my) Then ' Mouse is within text line.
If Mid$(linkmap(m.my), m.mx, 1) = "*" Then
_MouseShow "LINK"
m.CursorStyle = 1
Else
_MouseShow "TEXT"
m.CursorStyle = 0
End If
Else
_MouseShow "DEFAULT"
m.CursorStyle = 0
End If
Locate 25, 1: Print Space$(_Width);
Locate 25, 1: Print "Page Width ="; w; "#Chrs ="; linelength(m.my); " Mouse y, x = "; LTrim$(Str$(m.my)); ","; m.mx; " Character Map:"; id(m.my, m.mx); Mid$(x$, id(m.my, m.mx), 1);
If _Resize Then Exit Do
b$ = InKey$
If Len(b$) Then
If b$ = Chr$(27) Then System
Select Case Mid$(b$, 2, 1) ' Change right margin.
Case "K"
If w > 1 Then w = w - 1
Exit Do
Case "M"
If w < rswidth Then w = w + 1
Exit Do
End Select
End If
Loop
If b$ = "" And m.lb_status Then w = _ResizeWidth \ _FontWidth - 1: rswidth = w: If w > 80 Then w = 80
Loop
End
zero_variables:
ReDim id(_Height, _Width) As Integer
ReDim linelength(_Height) As Integer
ReDim linkmap(_Height)
i% = 0: j% = 0: row% = 4: col% = 0: flag = 0: linkmap(CsrLin) = String$(w, Chr$(0))
Return
default_variables:
Color 0
tag$ = ""
link$ = ""
Return
displayit:
Print c$;
id(CsrLin, col%) = i% ' Allows the mouse to find where the displayed text is in the original formatted text.
If col% = 1 Then ' The row has advanced.
linelength(CsrLin - 1) = cc ' Complete the character count of the line above.
linkmap(CsrLin) = String$(w, Chr$(0)) ' Reset (blank) the link map for the current line.
cc = 0 ' Reset the charcter counter.
Else
cc = cc + 1 ' Advance the character counter.
End If
Return
Sub mouse (m As mousevar)
' Local vars: i%,j%
Static oldmx As Integer, oldmy As Integer
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -2
m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
Case -1
m.lb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.lb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.lb_status ' Note drag is determined in the text highlighting routine.
Case -1
' An event occurred and the button is still down.
If oldmx <> m.mx Or oldmy <> m.my Then m.lb_status = 2 ' Drag.
Case 0
m.lb_status = 1 ' Left button was just pressed.
Case 1
m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -2
m.rb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
Case -1
m.rb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.rb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.rb_status
Case -1
' An event occurred and the button is still down.
Case 0
m.rb_status = 1 ' button was just pressed.
Case 1
m.rb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
oldmx = m.mx: oldmy = m.my
End Sub
Yes, the links are active, so happy surfing!
Pete
PrintW - print a long string, breaking it at the last space or hyphen before col. 79
