又不想专门写个自定义的控件，于是我结合就用了子类化和VB自带的事件机制对TextBox进行了扩展。关键代码如下，下面的是对窗体进行子类化，当窗体上的文本控件自动获得焦点的时，把控件引用保存到我的自定义类中，在自定义类中捕获textBox的change事件。这个是个半成品，只是提供了一个思路。

@H_403_14@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事件。

@H_403_14@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那么方便的对窗体进行扩展。