|
本文所说自动列表技术是指类似于VB、VC6.0中的自动列出成员功能，用过它的朋友恐怕都不会陌生吧！当系统能确定您即将输入的单词在某一有限范围内时，它就会将所有可能输入列出来，并根据你输入的不完整的单词、从列表中选出最匹配的单词自动输入。这种技术大大提高了录入效率，特别是在某些数据库程序中非常有利于提高输入速度、降低出错率和减少录入人员的劳动量。
现在，我们来做一个名叫AutoList的控件，同时用一个简单的应用程序演示它的功能。您将会看到，把此控件加入应用程序中，只须写少量代码就可使普通文本框具有“自动列表”的特性。
一、AutoList控件的制作：
VB提供了较完善的控件开发工具，用它提供的丰富的控件-应用程序接口方式可以方便、迅速的开发各种控件。编码之前，我们确定要开发的AutoList控件应具有如下特性：
A）键入指定的单词后，弹出对应的列表框。
B）弹出列表框后，根据随后键入的不完整的单词，加亮显示第一个匹配的列表项。
C）鼠标双击任意列表项，列表项跳出到光标处；若有列表项被加亮显示，敲入一个分隔符（分隔符的定义随后说明）则该列表项跳出到光标处。
D）光标离开当前输入单词范围，列表框消失。
E）其它用户易于操作的特性。
知道需要实现以上功能后，现在结合源代码简要介绍一下编制AutoList控件的基本思路和主要技巧：
控件中声明了一个窗体变量fOwnForm，两个文本框变量mOwnEdit、fOwnEdit。其中，fOwnForm和fOwnEdit是全局变量，mOwnEdit是模块级变量。fOwnForm的作用是让控件知道弹出的列表框应浮动与哪个窗体之上。mOwnEdit就是我们要使它具有自动列表功能的文本框。声明mOwnEdit变量时用了WithEvents关键字，这样，在控件内部就能捕获到mOwnEdit的事件，从而大大提高了控件的封装性能。而fOwnEdit与mOwnEdit表示的是同一个文本框，只是fOwnEdit为全局变量，使控件中的其它模块能访问此文本框。
为了让AutoList知道何时弹出对话框，外部程序必须向控件加入关键字集合Keys和分隔符集合Separators，分隔符就是分开相邻单词的间隔符（如空格等），程序通过分隔符来分辨一个单词。当满足以下要求时弹出Key对应的列表项：(1) 输入了一个单词Key，且Key属于集合Keys。(2) 紧跟Key后键入了一个分隔符Separator，Separator属于集合Separators。我想，用过VB的朋友应该容易理解这种处理方式。
为了让AutoList的列表框在光标位置弹出，引用了两个API函数：GetCaretPos()和ClientToScreen()。GetCaretPos()获得当前光标在客户区的坐标，ClientToScreen()将此坐标转化为对应的屏幕坐标。另外，由于文本框没有TextHeight属性，在得到文本框字符高度时，采用了一个较迂回的办法：将文本框的Font对象赋给窗体，利用窗体的TextHeight属性间接得到文本框的字符高度。要注意单位变换。
制作该控件主要要注意的就这些，源代码中也有较详细的注释。现介绍编制它的全过程。
1）打开VB，在新建工程的对话框中选ActiveX Control，新建一个工程。选菜单Project\Add Form，在弹出的对话框中选Flash Screen加入一个无标题条的窗体，将它的名字改为fBox，删除窗体中所有默认的控件，并向窗体中加入一个ListBox控件。设置其属性值如表中所示。
选菜单Project\Add Module 加入 一代码模块 ， 在此模块中加入代码如下：
'代码模块 Module1.bas 定义全局变量和函数。
Option Explicit
Global bListting As Boolean '列表框是否已经弹出
Global fOwnEdit As TextBox '与此控件相连的文本框
Global fOwnForm As Form '文本框所在的窗体
Global Keys As New Collection '容纳列表框的集合
Global iNum As Integer '列表框总数
Global Separators As New Collection '分隔符集合
Global lEnd As Long '暂存上次文本框中的光标位置
Global lThis As Long '暂存本次文本框中的光标位置
Public Function GetLastString(iStart As Integer)
'取得刚输入的字符串,最大长度为 100
Dim tempStr As String, sSingle As String
Dim i As Long
sSingle = ""
tempStr = ""
For i = 0 To 100
If i >= iStart Then GoTo Exit2
sSingle = Mid(fOwnEdit.Text, (CLng(iStart) - i), 1)
If IsSeparator(sSingle) Then GoTo Exit2 '遇到分隔符，返回
tempStr = Mid(fOwnEdit.Text, CLng(iStart) - i, 1) + tempStr
Next
Exit2:
GetLastString = tempStr
End Function
Public Function IsSeparator(sChr As String) As Boolean
'判断是否分隔符,空格是默认的分隔符
Dim sSeparator As Variant
If sChr = Chr(10) Or sChr = Chr(13) Or sChr = " " Then
IsSeparator = True
Exit Function
End If
For Each sSeparator In Separators
If sChr = sSeparator Then
IsSeparator = True
Exit Function
End If
Next
IsSeparator = False
End Function
2）在工程管理器中，双击UserControl1，弹出控件设计窗体，在属性列表中将UserControl1的名字改为AutoList。双击控件设计窗体的用户区，在弹出的代码窗口中加入以下代码：
'模块 AutoList 处理控件与外部程序的接口
'主要通过 mOwnEdit 实现接口
Option Explicit
Dim lActive As ListBox '当前列表框
Dim LockKey As Boolean '是否锁定上下键
Dim LockStart As Long '锁定上下键时光标位置
Dim WithEvents mOwnEdit As TextBox '与之关联的文本框
Public Sub AddSeparator(sSeparator As String)
'添加分隔符
If sSeparator = " " Then Exit Sub '空格是保留的分隔符
If Len(sSeparator) <> 1 Then Exit Sub
Separators.Add sSeparator
End Sub
Public Sub DelSeparator(sSeparator As String)
'删除分隔符
On Error Resume Next
Dim i As Integer
If sSeparator = " " Then Exit Sub '空格是保留的分隔符
If Len(sSeparator) <> 1 Then Exit Sub
For i = 1 To Separators.Count
If Separators(i) = sSeparator Then
Separators.Remove i
Exit Sub
End If
Next
End Sub
Public Property Set OwnForm(fForm As Object)
'文本框所在的窗体
Set fOwnForm = fForm
End Property
Public Property Set OwnEdit(eEdit As Object)
'与此控件连接的文本框
Set mOwnEdit = eEdit 'mOwnEdit 用以响应事件
Set fOwnEdit = eEdit 'fOwnEdit 为全局变量,
'供其它模块引用
End Property
Public Sub AddKey(sKey As String)
'添加用以激活此控件的关键字
'On Error Resume Next
Dim i As Integer
For i = 1 To iNum
With fBox.List1(i)
If .Tag = "free" Then
.Tag = "" '清除标志
Keys.Add fBox.List1(i), sKey '加入集合 Keys,关键字为 sKey
Exit Sub
End If
End With
Next
iNum = iNum + 1
Load fBox.List1(iNum) '加载 List1 控件
Keys.Add fBox.List1(iNum), sKey
End Sub
Public Sub DelKey(sKey As String)
On Error Resume Next
Dim i As Integer, j As Integer
i = Keys(sKey).Index
Keys.Remove sKey
With fBox.List1(i)
For j = .ListCount To 0 Step -1
.RemoveItem j
Next
.Tag = "free" '列表框已为空的标志
End With
End Sub
Public Sub AddList(sKey As String, sList As String)
On Error Resume Next
'向关键字 sKey 中添加列表项 sList
'当识别到用户输入 sKey 时将列出所有在这里加入的 sList 项
Keys(sKey).AddItem sList
End Sub
Public Sub DelList(sKey As String, sList As String)
'删除关键字 sKey 中的列表项 sList
On Error Resume Next
Dim i As Integer
With Keys(sKey)
For i = 0 To .ListCount
If .List(i) = sList Then
.RemoveItem i
End If
Next
End With
End Sub
Public Sub PopList(sKey As String)
'弹出此控件
fBox.PopOut sKey
End Sub
Public Sub FreeMem()
'清除内容，释放所有动态装载的对象，
'供外部程序重新利用
On Error Resume Next
Dim i As Integer
For i = Keys.Count To 1 Step -1
Keys.Remove i
Next
For i = Separators.Count To 1 Step -1
Separators.Remove i
Next
For i = 1 To iNum
Unload fBox.List1(i)
Next
iNum = 0
End Sub
Private Sub mOwnEdit_KeyDown(KeyCode As Integer, Shift As Integer)
'在次事件中处理输入字符串和分隔符,说明如下：
'第一层 if 条件语句：对fBox是否弹出的情况分别处理
'第二层 if 条件语句：若fBox未弹出，对分隔符和非分隔符分别处理
' 若fBox已弹出，先处理控制键(方向键和Esc键)
' 再对分隔符和非分隔符分别处理
Dim tempKey As String '刚输入的字符串
Dim lShow As ListBox
Dim SeparatorBak As Boolean '刚输入的字符是否为分隔符
Dim lLen As Long, selBak As Long, TxtBak As String
On Error Resume Next
DoEvents
If LockKey Then '键盘已锁定
If fOwnEdit.SelStart <> LockStart Then
'光标位置已改变，隐藏
LockKey = False
lEnd = 0: lThis = 0
bListting = False
Set lActive = Nothing
fBox.GoBack
End If
Exit Sub
End If
SeparatorBak = IsSeparator(Mid(fOwnEdit.Text, fOwnEdit.SelStart, 1))
' If SeparatorBak Then Stop
If Not bListting Then '若列表框未弹出(第一层 if 条件语句)
Select Case KeyCode
Case 38, 40, 37, 39, 8, 27
Exit Sub '若是方向键或退格键、Esc键,跳出
End Select
lEnd = fOwnEdit.SelStart
lThis = lEnd
If SeparatorBak Then '若是分隔符,取得并处理刚输入的字符串
'(第二层 if 条件语句)
If KeyCode = 13 Then
'因为多个换行符
tempKey = GetLastString(CInt(lEnd - 2))
Else
tempKey = GetLastString(CInt(lEnd - 1))
End If
If Len(tempKey) <= 1 Then Exit Sub
tempKey = Trim(tempKey)
If Mid(tempKey, Len(tempKey), 1) = Chr(13) Then _
tempKey = Left(tempKey, Len(tempKey) - 1)
Set lShow = Keys(tempKey) '在集合 Keys 中查找关键字为
'tempKey 的成员
If lShow Is Nothing Then Exit Sub '未找到,跳出
bListting = True
Set lActive = lShow
PopList tempKey
Else '不是分隔符,跳出(第二层 if 条件语句)
Exit Sub
End If
Else '若列表框已弹出(第一层 if 条件语句)
Select Case KeyCode
Case 37, 39, 8, 27 '若是左右键、退格键或 Esc 键
selBak = fOwnEdit.SelStart
If KeyCode = 37 Then '计算响应此键后光标的位置
selBak = selBak - 1
ElseIf KeyCode = 39 Then
selBak = selBak + 1
ElseIf KeyCode = 8 Then
lThis = fOwnEdit.SelStart
'向列表框发送字符串,查找于之匹配的列表项
fBox.ReceiStr GetLastString(fOwnEdit.SelStart)
End If
If selBak < lEnd Or selBak > lThis _
Or KeyCode = 27 Then '若光标离去或按下“Esc”键，隐藏
lEnd = 0: lThis = 0
bListting = False
Set lActive = Nothing
fBox.GoBack
End If
Exit Sub
Case 38, 40
LockStart = fOwnEdit.SelStart
LockKey = True '锁定上下键用于滚动列表框
With fBox.lThisList
.SetFocus
If KeyCode = 38 Then
If .ListIndex = -1 Then .ListIndex = .ListCount - 1 _
Else .ListIndex = .ListIndex - 1
Else
.ListIndex = .ListIndex + 1
End If
End With
Exit Sub
End Select
If SeparatorBak Then '若输入分隔符,将列表项插入到文本框
'(第二层 if 条件语句)
With fOwnEdit
If lActive.ListIndex >= 0 Then
lLen = .SelStart - lEnd '须替换的长度
.SelStart = lEnd
.SelLength = lLen
.SelText = lActive.Text '插入
' DoEvents
TxtBak = Chr(KeyCode) '加上刚输入的字符
End If
lEnd = 0 '复位标志
bListting = False
Set lActive = Nothing
fBox.GoBack
If TxtBak <> "" Then
fOwnEdit.SetFocus
SendKeys TxtBak '补上刚输入的字符
DoEvents
End If
Exit Sub
End With
Else '若输入的不是分隔符(第二层 if 条件语句)
lThis = fOwnEdit.SelStart
'向列表框发送字符串,查找于之匹配的列表项
fBox.ReceiStr GetLastString(fOwnEdit.SelStart)
End If
End If
End Sub
|
