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

Window窗体研究 专栏收录该内容
3 篇文章 0 订阅

由于需要维护很多的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", "fnumber", 1050
   mfrmAc.ListView1.ColumnHeaders.Add 2, "fname", "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, 0, 0, 0, 0, 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那么方便的对窗体进行扩展。
  • 0
    点赞
  • 0
    评论
  • 3
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值