初
初学者1
Unregistered / Unconfirmed
GUEST, unregistred user!
“实现下拉式组合框的动态标注”长期以来一直是个老大难问题。本文运用屏幕取词技术使该问题得以圆满解决。屏幕取词还可应用于复杂表格的动态标注，其作用是大幅度降低系统开销。本文还将介绍用屏幕取词实现的动态标注在软件封面制作以及文本文件的超链接敏感标注等方面的应用。
一、应用屏幕取词实现组合框的动态标注
“组合框的动态标注”有两层含义：其一，当鼠标滑过未展开的组合框时产生提示性标注；其二，组合框被点开后，当鼠标滑过下拉区域中的数据项时，能根据不同的数据项产生不同的标注信息。
普通的组合框控件（ComboBox）根本就不产生 MouseMove事件，因此上述两点完全无从谈起。能与数据库相连的组合框控件（ DBCombo）以及能同 ADO一起工作的组合框控件（ DataCombo）虽能产生 MouseMove事件，但上述的第二点依然无法实现。
只有返回鼠标捕捉的词才能顺利解决这个问题。向编辑类控件（ TextBox控件及RichTextBox 控件等）发送EM_CHARFROMPOS消息可以实现屏幕取词。该消息的语法为：
EM_CHARFROMPOS
wParam = 0;
//未使用
lParam = (LPARAM) (POINTL *) lpPoint;
//指向POINTL结构（X、Y坐标）的指针
该消息的功能是返回编辑类控件中离鼠标所指位置最近的字符的偏移量。该偏移量并非相对于当前行，而是相对于整个控件的开始。但是通过简单的计算我们不难得到鼠标所指向的词以及所指向的文本行。
既然组合框本身就是由 TextBox控件和 ListBox控件的特性结合在一起实现的，因此我们完全可以用 TextBox控件及 RichTextBox控件再造一个充分支持动态标注的新的组合框。下面的示例程序就是有动态标注功能的新组合框的完整代码。图一展示了新组合框的动态标注情况：随着鼠标在下拉区域内的滑动，当前行被高亮显示，同时相应的帮助信息立即出现在鼠标下方。
在具体实现中应注意以下几点：
（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
Private Sub Form_Load()
rchCombo.Text = "Business Scope" + Chr(13) + Chr(10) + _ ' 组合框赋值
"Sales" + Chr(13) + Chr(10) + _
"Imp./Exp." + Chr(13) + Chr(10) + _
"Date Established" + Chr(13) + Chr(10) + _
"Company Name" + Chr(13) + Chr(10) + _
"Company Address" + Chr(13) + Chr(10) + _
"Post Code" + Chr(13) + Chr(10) + _
"Executives" + Chr(13) + Chr(10) + _
"Activities" + Chr(13) + Chr(10) + _
"Email" + Chr(13) + Chr(10) + _
"Web Address" + Chr(13) + Chr(10) + _
"Telephone" + Chr(13) + Chr(10)
rchCombo.SelStart = 0: rchCombo.SelLength = Len(rchCombo)
rchCombo.SelProtected = True ' 将数据项锁定以防止被编辑
rchCombo.SelLength = 0
End Sub
Private Sub rchCombo_Click()
Text1.Text = rchCombo.SelText ' 高亮显示的文本正是被选中的数据项
Call VScroll1_Change ' 关闭下拉区域
End Sub
Private Sub rchCombo_MouseMove(Button As Integer, Shift As Integer, _
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行。
由于 RichTextBox具有的强大功能，仿真上图左侧众 Label的外观（如字体、颜色及版式等）并非难事。这种动态标注方式应用于极复杂表格时效果非常明显。
因为实现思想类似，故此处略去示例程序。
2、软件封面
在上图所示的软件封面中可用屏幕取词技术实现动态标注，即：当用户鼠标滑过上图箭头后方的文字时，立即显示提示信息并用改变鼠标形状或用起伏的文字等方式给用户以响应。
由于 RichTextBox控件支持 OLE对象的剪贴板和OLE拖/放操作及对象的嵌入，因此制作一个图文并茂的软件封面并不困难。同样地，用屏幕取词方法实现的动态标注可以节约系统资源（示例代码略）。
3、超链接
动态识别并标注文本文件中的超链接是屏幕取词技术的一个比较经典的应用。
这里给出一个小巧的示例程序（运行时情况见上图）。在该例中，RichTextBox控件内被装入一个 RTF文件（当然也可以是一个文本文件），当用户鼠标滑过超链接时，鼠标形状变为手指状，同时鼠标下方给出超链接的地址，提示用户可以对超链接的进行点击。该例子还给出了在VB中调用缺省浏览器和缺省 Email程序的最为简捷的方法（仅各用一行代码）。
' 程序二：支持超链接的文本框（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