我也没用过,试试吧:
程序二:支持超链接的文本框(VB6)
Option Explicit
Dim Offset As Long ' 偏移量
Private Type POINTXY
x As Long
y As Long
End Type
Private Const EM_CHARFROMPOS& = &HD7
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Public Function Return_Offset(rchText As RichTextBox, x As Single, y As _
Single) As Long
Dim XY As POINTXY
XY.x = x \ Screen.TwipsPerPixelX
XY.y = y \ Screen.TwipsPerPixelY
' 返回偏移量
Return_Offset = SendMessage(rchText.hWnd, EM_CHARFROMPOS, 0&, XY)
End Function
Private Sub Form_Load()
' 装入 RTF文件
RichTextBox1.LoadFile "C:\Program Files\WinZip\Wzqkstrt.rtf"
End Sub
Private Sub RichTextBox1_Click()
If Offset > 9172 And Offset < 9195 Then
Shell "start http://www.winzip.com" ' 打开默认浏览器的最简方法
End If
If Offset > 9233 And Offset < 9250 Then
Shell "start mailto:help@winzip.com" ' 打开默认邮件软件的最简方法
End If
End Sub
Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, _
x As Single, y As Single)
Offset = Return_Offset(RichTextBox1, x, y) ' 计算偏移量
' 为简捷起见,本例使用预知的偏移量定位超链接
If (Offset > 9172 And Offset < 9195) Or _
(Offset > 9233 And Offset < 9250) Then
RichTextBox1.MouseIcon = LoadPicture("D:\Hand.ico") ' 改变鼠标形状
RichTextBox1.MousePointer = 99
If Offset > 9195 Then
RichTextBox1.ToolTipText = "mailto:help@winzip.com" ' 显示提示
Else
RichTextBox1.ToolTipText = "http://www.winzip.com"
End If
Else
RichTextBox1.MousePointer = 0 ' 鼠标形状还原
RichTextBox1.ToolTipText = "" ' 关闭提示
End If
End Sub
X As Single, Y As Single)
Dim tmp1 As String
rchCombo.SetFocus ' 获取焦点以便于高亮显示
tmp1 = Return_Line(rchCombo, X, Y) ' 捕获鼠标指向的当前行
Select Case tmp1 ' 随着鼠标的滑动不断给出帮助信息
Case "Imp./Exp."
tmp1 = "查询企业的年进出口总额"
Case "Sales"
tmp1 = "查询税前的年销售额"
Case "Date Established"
tmp1 = "查询企业的成立日期"
End Select
' 在鼠标下方显示动态标注信息
If rchCombo.ToolTipText <> tmp1 Then rchCombo.ToolTipText = tmp1
End Sub
Private Sub VScroll1_Change()
Dim i As Integer
If Drop1 = 0 Then ' 打开下拉区域
rchCombo.Top = -2160
rchCombo.Visible = True
For i = 1 To 80 ' 仿真组合框被下拉的动态效果
rchCombo.Top = rchCombo.Top + 30
Next i
Else ' 关闭下拉区域
rchCombo.Top = -2160
rchCombo.Visible = False
End If
Drop1 = 1 - Drop1 ' 更新标志
End Sub
在上面的代码中,我们只为三个数据项赋予了解释性标注,而其余数据项的标注
正是数据项本身(见图一右半部分)。这种设计是源于动态标注的一个重要应用:当
数据项的长度大于组合框的宽度而无法完全显示时,动态标注可让用户看到全文。大
家对动态标注的这一应用应当不陌生,因为甚至在资源管理器中我们都可感受到它的
存在。微软的MSDN网站上有一篇很复杂的文章,介绍在VB中如何调用一些 API函数来
解决组合框宽度影响数据项显示的问题。相比之下可以看出,用屏幕取词法解决该问
题是非常轻松的。
二、屏幕取词的其它动态标注应用
1、复杂表格
在复杂表格的动态标注中使用屏幕取词技术可以大大减少表格上 Label控件的数量,这将极大地减小系统开销并提高维护效率。例如,可以将下图中左侧的12个Label控件换为一个RichTextBox控件,然后将12个MouseMove事件代码并入RichTextBox的 MouseMove中,运行时用屏幕取词技术区分这12行。
在具体实现中应注意以下几点:
(1) 由于不再需要用 AddItem方法填加数据项而仅仅是需要对RichTextBox.Text进行赋值,因此当要求数据项有序时应先排序再赋值。
(2) 应使用SelProtected属性和 MaxLength属性将全部数据项锁定,以防止用户在使用过程中对数据项进行编辑。
(3) 新组合框其实是由三个部分组成的,除了TextBox (用于输入信息以便快速查找数据项和存储被选中的数据项)以及带垂直滚动条的 RichTextBox(下拉区域)外,第三部分是右侧的下拉按钮。可以用能显示图片的命令按钮来实现。为了简捷,本文的例子中使用了一个上半部分被窗体遮挡的垂直方向的滚动条来模拟之。
(4) 如果数据项中有中文,则下述程序须稍加改动,因为计算字符串长度的函数将一个汉字算为一个字符,而发送EM_CHARFROMPOS消息后返回的偏移值将一个汉字计为两个字符。
(5) 在新组合框被展开时应使 RichTextBox控件快速下滑以模拟下拉框被弹出的效果。
' 程序一:支持动态标注功能的组合框(VB6)
Option Explicit
Dim Drop1 As Integer ' 组合框是否被下拉的标志
Private Type POINTXY
X As Long
Y As Long
End Type
Private Const EM_CHARFROMPOS& = &HD7
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Public Function Return_Line(Combo1 As RichTextBox, X As Single, Y As _
Single) As String
Dim XY As POINTXY
Dim Offset As Integer
Dim i As Integer, j As Integer
XY.X = X \ Screen.TwipsPerPixelX
XY.Y = Y \ Screen.TwipsPerPixelY
' 向 RichTextBox控件发送EM_CHARFROMPOS消息
Offset = SendMessage(Combo1.hWnd, EM_CHARFROMPOS, 0&, XY)
If Offset <= 0 Then Exit Function
For i = Offset To 1 Step -1 ' 搜索行首
If Asc(Mid$(Combo1.Text, i, 1)) = 10 Then Exit For
Next i
For j = Offset To Len(Combo1.Text) ' 搜索行尾
If Asc(Mid$(Combo1.Text, j, 1)) = 13 Then Exit For
Next j
i = i + 1: j = j - 1
If i <= j Then
Return_Line = Mid$(Combo1.Text, i, j - i + 1) ' 返回鼠标指向的行
' 将当前行高亮显示。这里加入条件语句的目的是防止画面抖动(闪烁)。
If rchCombo.SelStart <> i - 1 Then
rchCombo.SelStart = i - 1
rchCombo.SelLength = j - i + 1
End If
End If
End Function