Question

VB代码，这种效果能实现，实现的话要用哪些控件？

还是接上一个问题，http://zhidao.baidu.com/question/174180492.html 上问题代码，文字颜色统一下划线了，写入库里错误了。 这次认真整理下，再次求助VB老大。谢谢了 这次带上效果图片： 效果1：
效果2：
===================== [@干什么] 你和他和我干什么 ╔══════╦════╗ ║ ║ ║ ╠══════╬════╣ ║ ║ ║ ╚══════╩════╝ ╔══════╗ ║║ ╚══════╝ [@1] 你找我吗 ╔══════╗ ║ ║ ╚══════╝ 增加活动属性。 不论什么内容在里面,只要这个/@正确,(如只有/或@,点击都没有反应),就可以点击进入下一个. 例:点击 进入[@1]这个页面.就是有个循环,如有**/@*进入设置了的[@*]就可以进入下一页.





Answer 1

FORM1中添加一个文本框和一个按钮，粘贴如下代码：
Private Sub Command1_Click()
Dim s As String
Dim t As String, u As String
s = Text1.Text
Dim l As Long
Dim r As Long
Form2.Show
Form2.Cls

For l = 1 To Len(s)
If Mid(s, l, 1) = "[" 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)
Form2.AddRect Form2.CurrentX, Form2.CurrentY, Form2.TextWidth(t), Form2.TextHeight(t), u
Form2.ForeColor = vbYellow
Form2.FontUnderline = True
Form2.Print t;
Form2.FontUnderline = False
Else
If InStr(t, "@") > 0 Then
t = Left(t, InStr(t, "@") - 1)
End If
Form2.ForeColor = vbRed
Form2.Print t;
End If
l = l + r - 1
Form2.ForeColor = vbWhite
End If
Else
If Mid(s, l, 2) = vbCrLf Then
Form2.Print
l = l + 1
Else
Form2.Print Mid(s, l, 1);
End If
End If
Next l
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

-------------------------------

FORM2中设置autoredraw属性为true，然后粘贴如下代码：
注意的是，鼠标移动到链接的地方的时候，图标不是手形而是问号，是因为VB不带，你可以自己选择加载它，还有就是浏览器路径可能有变化你需要手工改
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
Debug.Print X, Y, w, h, u
End Sub

Private Sub Form_Load()
ReDim LinkRect(0 To 0) As MyRect
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim l As Long
Debug.Print X, Y
For l = 1 To UBound(LinkRect)
Debug.Print X >= LinkRect(l).Left, X <= LinkRect(l).Width + LinkRect(l).Left, Y >= LinkRect(l).Top, Y <= LinkRect(l).Height + LinkRect(l).Top
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
Shell Environ("ProgramFiles") & "\Internet Explorer\IEXPLORE.EXE """ & LinkRect(l).Url & """", vbNormalFocus
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