由于需要维护很多的VB代码，而这些代码中，对基础资料的处理清一色的都是采用ComBox控件来实现基础资料的列表显示，把基础资料的fnumber和fname放到comBox一个项里面，通过在其中加50个空格来区分。效果图如下：
又不想专门写个自定义的控件，于是我结合就用了子类化和VB自带的事件机制对TextBox进行了扩展。关键代码如下，下面的是对窗体进行子类化，当窗体上的文本控件自动获得焦点的时，把控件引用保存到我的自定义类中，在自定义类中捕获textBox的change事件。这个是个半成品，只是提供了一个思路。
Public Function SubWndProc(ByVal hwnd As Long,ByVal uMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Select Case uMsg
Case WM_ACTIVATE
If (wParam And &HFFFF) = WA_INACTIVE Then
DebugPrint "WM_ACTIVATE,失去激活"
End If
If (wParam And &HFFFF) = WA_CLICKACTIVE Then
DebugPrint "WM_ACTIVATE,鼠标激活"
Debug.Print CStr(lParam)
If lParam = Form1.hwnd Then
DebugPrint "激活的窗体句柄是FORM1.HWND"
End If
If lParam = Form1.Text1.hwnd Then
DebugPrint "激活的窗体句柄是FORM1.HWND"
End If
End If
If (wParam And &HFFFF) = WA_ACTIVE Then
DebugPrint "WM_ACTIVETE,非鼠标激活"
End If
Case WM_KILLFOCUS
DebugPrint "WM_KillFocus"
Case WM_COMMAND
'收到WM_COMMAND后，先判断是哪个控件发送的
'不同控件的通知码不一样，其对应的消息类型不一样
Dim bFind As Boolean
Dim i As Integer
i = Form1.Controls.Count - 1
bFind = False
Do While (Not bFind And i >= 0)
If Form1.Controls(i).hwnd = lParam Then
bFind = True
'找到控件后，判断控件的类型
Select Case TypeName(Form1.Controls(i))
Case "TextBox"
If CInt((wParam / &H10000)) = EN_SETFOCUS Then
DebugPrint "EN_SETFOCUS"
If oTextEx Is Nothing Then
Set oTextEx = New ClsTextBoxEx
End If
oTextEx.Attach Form1.Controls(i)
oTextEx.SetConnString "Provider=sqlNCLI10;Password=k3manager;Persist Security Info=True;User ID=sa;Initial Catalog=AIS20140709093851;Data Source=."
End If
If CInt(wParam / &H10000) = EN_KILLFOCUS Then
DebugPrint "EN_KILLFOCUS"
If Not oTextEx Is Nothing Then
Set oTextEx = Nothing
End If
End If
End Select
End If
i = i - 1
Loop
Case WM_CLOSE
DebugPrint " FORM WM_CLOSE"
If Not oTextEx Is Nothing Then Set oTextEx = Nothing
Case WM_DESTROY
DebugPrint " FORM WM_DESTORY"
End Select
SubWndProc = CallWindowProc(lpPreProc,hwnd,uMsg,wParam,lParam)
End Function
下面是我的自定义类，定义了一个withevent的textBox变量，扩展了 Change事件。
Private strCnn As String Private strTable As String Private WithEvents mtxt As VB.TextBox Private lPreHwnd As Long Private lNowHwnd As Long Private mCnn As ADODB.Connection Private mfrmAc As frmAutoComlete 'strCnn = "Provider=sqlNCLI10;Password=k3manager;Persist Security Info=True;User ID=sa;Initial Catalog=AIS20140709093851;Data Source=." Public Sub Attach(ByVal o As VB.TextBox) If Not mtxt Is Nothing Then Set mtxt = Nothing If Not gdest Is Nothing Then Set gdest = Nothing Set mtxt = o Set gdest = o End Sub Public Sub SetConnString(ByVal param As String) strCnn = param LoadResource End Sub Public Sub DestroyResource() '去除cnn的连接 If Not mCnn Is Nothing Then If mCnn.State = adStateOpen Then mCnn.Close Set mCnn = Nothing End If '卸载窗体 If Not mfrmAc Is Nothing Then Unload mfrmAc Set mfrmAc = Nothing End If End Sub Public Function LvHWnd() As Long LvHWnd = 0 If Not mfrmAc Is Nothing Then LvHWnd = mfrmAc.ListView1.hwnd End Function Private Sub LoadResource() '建立连接对象 If mCnn Is Nothing Then Set mCnn = New ADODB.Connection mCnn.ConnectionString = strCnn mCnn.CursorLocation = adUseClient '装载窗体 Set mfrmAc = New frmAutoComlete Load mfrmAc '初始化窗体上的资源 mfrmAc.ListView1.ColumnHeaders.Add 1,"fnumber",1050 mfrmAc.ListView1.ColumnHeaders.Add 2,"fname",1500 mfrmAc.Timer1.Enabled = False End Sub Private Sub mtxt_Change() Dim oRst As ADODB.Recordset Dim olv As ListView Dim strsql As String Dim lngHeights As Long mfrmAc.Visible = False mfrmAc.Timer1.Enabled = False '根据mtxt的内容来拼接sql If Len(mtxt.Text) = 0 Then Exit Sub If Len(mtxt.Text) = 1 And Left(mtxt.Text,1) = Chr(13) Then '带出上一轮的输入 Exit Sub Else strsql = "select top 10 fnumber,fname from t_item where fitemclassID = 4 and ( fnumber like '%" & mtxt.Text & "%' or fname like '%" & mtxt.Text & "%')" End If If mCnn.State = adStateClosed Then mCnn.Open Set oRst = mCnn.Execute(strsql,adCmdText) Set oRst.ActiveConnection = Nothing mCnn.Close If oRst Is Nothing Or oRst.RecordCount = 0 Then GoTo TXT oRst.MoveFirst 'ListView控件初始化 lngHeights = 0 Set olv = mfrmAc.ListView1 olv.ListItems.Clear While Not oRst.EOF Dim ListItem As ListItem Set ListItem = mfrmAc.ListView1.ListItems.Add() ListItem.Text = CStr(oRst!fnumber) ListItem.SubItems(1) = CStr(oRst!fname) lngHeights = lngHeights + ListItem.Height oRst.MoveNext Wend Dim lpLv As POINTAPI lpLv.x = mtxt.Left / Screen.TwipsPerPixelX lpLv.y = (mtxt.Top + mtxt.Height) / Screen.TwipsPerPixelY ClientToScreen mtxt.Container.hwnd,lpLv 'SetParent mfrmAc.hwnd,mtxt.Container.hwnd MoveWindow mfrmAc.hwnd,lpLv.x,lpLv.y,2550 / Screen.TwipsPerPixelX,(lngHeights + 30) / Screen.TwipsPerPixelY,0 mfrmAc.Timer1.Enabled = True ShowWindow mfrmAc.hwnd,SW_SHOWNOACTIVATE SetWindowPos mfrmAc.hwnd,HWND_TOPMOST,SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE 'UpdateWindow mfrmAc.hwnd TXT: If Not oRst Is Nothing Then If oRst.State = adStateOpen Then oRst.Close Set oRst = Nothing End If End Sub Private Sub Class_Terminate() '去除绑定 If Not mtxt Is Nothing Then Set mtxt = Nothing If Not gdest Is Nothing Then Set gdest = Nothing '卸载资源 DestroyResource End Sub Private Sub mtxt_KeyDown(KeyCode As Integer,Shift As Integer) Dim olv As ListView Dim xlm As ListItem Dim rows As Long If KeyCode = 40 And mfrmAc.Visible Then '向下键 Set olv = mfrmAc.ListView1 Set xlm = olv.SelectedItem rows = olv.ListItems.Count If xlm.Index = rows Then Exit Sub olv.ListItems(xlm.Index + 1).Selected = True End If If KeyCode = 38 And mfrmAc.Visible Then '向上键 Set olv = mfrmAc.ListView1 Set xlm = olv.SelectedItem rows = olv.ListItems.Count If xlm.Index = 1 Then Exit Sub olv.ListItems(xlm.Index - 1).Selected = True End If If KeyCode = 13 Then '回车键 If mfrmAc.Visible Then '若是有弹出框的话，取弹出框选择行 Set olv = mfrmAc.ListView1 Set xlm = olv.SelectedItem mtxt.Text = xlm.SubItems(1) mfrmAc.Visible = False End If End If End Sub结果是最终效果实现了，但是弹出框却无法响应鼠标事件，只能通过键盘来进行选择。VB毕竟已经过时了，不像MFC，C#的WinForm那么方便的对窗体进行扩展。