Question

VB代码，前面文字多了下划线，就一处地方，具体看图片

还是接上一个问题http://zhidao.baidu.com/question/175137777.html 看了很久都知道改那里，再次求助VB高手，谢谢。 图片：
看了很久都不知道改那里，图片是错误效果。

Answer 1

第二个窗口里的代码修改一下，注意看我加注释的那一行
Option Explicit
Public CodeString As String

Private Const LinkCount = 100
Private LinkRect() As MyRect
Private Type MyRect
Url As String
Left As Long
Top As Long
Width As Long
Height As Long
End Type

Public Sub AddRect(ByVal X As Long, ByVal Y As Long, ByVal w As Long, ByVal h As Long, u As String)
ReDim Preserve LinkRect(0 To UBound(LinkRect) + 1) As MyRect
LinkRect(UBound(LinkRect)).Left = X
LinkRect(UBound(LinkRect)).Top = Y
LinkRect(UBound(LinkRect)).Width = w
LinkRect(UBound(LinkRect)).Height = h
LinkRect(UBound(LinkRect)).Url = u
End Sub

Private Sub Form_Load()
ExplainCode SearchSection(Me.CodeString, "")
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim l As Long
For l = 1 To UBound(LinkRect)
If X >= LinkRect(l).Left And X <= LinkRect(l).Width + LinkRect(l).Left _
And Y >= LinkRect(l).Top And Y <= LinkRect(l).Height + LinkRect(l).Top Then
If SearchSection(Me.CodeString, LinkRect(l).Url) <> "" Then
ExplainCode SearchSection(Me.CodeString, LinkRect(l).Url)
End If
Exit Sub
End If
Next l
Me.MousePointer = 0
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim l As Long
For l = 1 To UBound(LinkRect)
If X >= LinkRect(l).Left And X <= LinkRect(l).Width + LinkRect(l).Left _
And Y >= LinkRect(l).Top And Y <= LinkRect(l).Height + LinkRect(l).Top Then
Me.MousePointer = 14
Exit Sub
End If
Next l
Me.MousePointer = 0
End Sub

Private Sub ExplainCode(Code As String)
Dim s As String
Dim t As String, u As String
s = Code
Dim l As Long
Dim r As Long
Me.Cls
ReDim LinkRect(0 To 0) As MyRect
For l = 1 To Len(s)
Me.FontUnderline = False '<-------加上这句应该可以了
If Mid(s, l, 2) = "[@" Then
r = InStr(Mid(s, l), "]")
If r > 0 Then
t = Mid(s, l + 1, r - 2)
l = l + r - 1
Form2.ForeColor = vbWhite
If Mid(s, l + 1, 1) = vbCr Then
l = l + 2
End If
End If
ElseIf Mid(s, l, 1) = "<" Then
r = InStr(Mid(s, l), ">")
If r > 0 Then
t = Mid(s, l + 1, r - 2)
If InStr(t, "/@") > 0 Then
u = Mid(t, InStr(t, "/@") + 2)
t = Left(t, InStr(t, "/@") - 1)
AddRect Form2.CurrentX, Form2.CurrentY, Form2.TextWidth(t), Form2.TextHeight(t), u
Me.ForeColor = vbYellow
Me.FontUnderline = True
Me.Print t;
Me.FontUnderline = False
Else
If InStr(t, "@") > 0 Then
t = Left(t, InStr(t, "@") - 1)
End If
Me.ForeColor = vbRed
Me.Print t;
End If
l = l + r - 1
Me.ForeColor = vbWhite
End If
Else
If Mid(s, l, 2) = vbCrLf Then
Me.Print
l = l + 1
Else
Me.Print Mid(s, l, 1);
End If
End If
Next l
End Sub

Private Function SearchSection(Code As String, SecName As String) As String
Dim s As String
s = Code
Dim i As Long
Dim r As Long
Dim t As String
Dim ss As Long
Dim sl As Long
For i = 1 To Len(s)
If Mid(s, i, 2) = "[@" Then
r = InStr(Mid(s, i), "]")
If r > 0 Then
t = Mid(s, i + 2, r - 3)
If SecName = t Or SecName = "" Then
ss = i
sl = InStr(Mid(s, i + r + 1), "[")
If sl = 0 Then
sl = Len(s) - ss + 1
Else
sl = sl + r
End If
Exit For
End If
End If
End If
Next i
If ss > 0 And sl > 0 Then SearchSection = Mid(Code, ss, sl)
End Function

Answer 2

没表达清楚