VB6对系统自带的TextBox控件的扩展实现模糊查询的功能

概述由于需要维护很多的VB代码，而这些代码中，对基础资料的处理清一色的都是采用Combox控件来实现基础资料的列表显示，把基础资料的fnumber和fname放到combox一个项里面，通过在其中加50个空格来区分。效果图如下： 于是我想写一个类似于百度搜索时候的自动提示的d出框，效果如下： 又不想专门写个自定义的控件，于是我结合就用了子类化和VB自带的事件机制对TextBox进行了扩展。关键代码如下

由于需要维护很多的VB代码，而这些代码中，对基础资料的处理清一色的都是采用ComBox控件来实现基础资料的列表显示，把基础资料的fnumber和fname放到comBox一个项里面，通过在其中加50个空格来区分。效果图如下：

于是我想写一个类似于百度搜索时候的自动提示的d出框，效果如下： 又不想专门写个自定义的控件，于是我结合就用了子类化和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 StringPrivate strtable As StringPrivate WithEvents mtxt  As VB.TextBoxPrivate lPreHwnd  As LongPrivate lNowHwnd  As LongPrivate mCnn  As ADODB.ConnectionPrivate 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 SubPublic Sub SetConnString(ByVal param As String)   strCnn = param   LoadResourceEnd SubPublic 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 IfEnd SubPublic Function LvHWnd() As Long   LvHWnd = 0   If Not mfrmAc Is nothing Then LvHWnd = mfrmAc.ListVIEw1.hwndEnd FunctionPrivate 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 = FalseEnd SubPrivate 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.hwndTXT:    If Not oRst Is nothing Then       If oRst.State = adStateOpen Then oRst.Close       Set oRst = nothing    End IfEnd SubPrivate Sub Class_Terminate()   '去除绑定   If Not mtxt Is nothing Then Set mtxt = nothing   If Not gdest Is nothing Then Set gdest = nothing   '卸载资源   DestroyResourceEnd SubPrivate 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      '若是有d出框的话，取d出框选择行          Set olv = mfrmAc.ListVIEw1          Set xlm = olv.SelectedItem          mtxt.Text = xlm.SubItems(1)          mfrmAc.Visible = False      End If   End IfEnd Sub

结果是最终效果实现了，但是d出框却无法响应鼠标事件，只能通过键盘来进行选择。VB毕竟已经过时了，不像MFC，C#的WinForm那么方便的对窗体进行扩展。 总结

以上是内存溢出为你收集整理的VB6对系统自带的TextBox控件的扩展实现模糊查询的功能全部内容，希望文章能够帮你解决VB6对系统自带的TextBox控件的扩展实现模糊查询的功能所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。