一篇关于在COMBOBOX中使用SENDMESSAGE的实例

最近经常有人问我这个问题索引就把代码贴出来大家一起共享吧!其实难度很低就是SENDMESSAGE的应用而已。但是实用性却瞒高,看到很多程序都有类似的功能。

程序功能:
在TEXTBOX中输入字符后马上在COMBOBOX中找匹配的字符串一但找到马上下拉COMBOBOX菜单并且选中此字符串。然后在这期间用户可以使用“F3”继续查找其他类似匹配的字符串,当用户按下“回车键”就使COMBOBOX复原并且选中特定字符串。并且附带添加指定字符串和插入指定字符串已经删除指定字符串等功能。

程序源码如下:

Option   Explicit
"******************************************************************************************************************
"显示XP风格函数
Private   Declare   Sub   InitCommonControls   Lib   "comctl32.dll"   ()
"******************************************************************************************************************
"SendMessage函数和本实例使用到的一些常量
Private   Declare   Function   SendMessage   Lib   "user32"   Alias   "SendMessageA"   (ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long
"Private   Const   WM_GETTEXTLENGTH   =   &HE
Private   Const   CB_GETCOUNT   =   &H146
"Private   Const   WM_GETTEXT   =   &HD
"Private   Const   WM_SETTEXT   =   &HC
Private   Const   CB_FINDSTRING   =   &H14C
Private   Const   CB_ADDSTRING   =   &H143
Private   Const   CB_GETCURSEL   =   &H147
Private   Const   CB_SELECTSTRING   =   &H14D
Private   Const   CB_SHOWDROPDOWN   =   &H14F
Private   Const   CB_GETEDITSEL   =   &H140
Private   Const   CB_GETEXTENDEDUI   =   &H156
Private   Const   CB_SETCURSEL   =   &H14E
Private   Const   CB_SETEDITSEL   =   &H142
Private   Const   CB_INSERTSTRING   =   &H14A
"按索引删除
Private   Const   CB_DELETESTRING   =   &H144
"当前选中的索引
Private   selectIndex   As   Long

Private   Sub   cmdAdd_Click()
        "添加字符串到ComboBox中
        If   Trim(textData.Text)   < >   ""   Then
                Call   SendMessage(Me.cbData.hwnd,   CB_ADDSTRING,   0,   ByVal   textData.Text)
                "更新索引记数
                Call   SendMessage(Me.cbInsert.hwnd,   CB_ADDSTRING,   0,   ByVal   CStr(cbData.ListCount   -   1))
        End   If
End   Sub

Private   Sub   cmdCancel_Click()
        "退出程序
        Unload   Me
End   Sub

Private   Sub   cmdDelete_Click()
        "删除指定字符串
        Dim   ret   As   Long
        If   Trim(textData.Text)   < >   ""   Then
                "先查找对应字符串的索引
                ret   =   SendMessage(Me.cbData.hwnd,   CB_FINDSTRING,   -1,   ByVal   textData.Text)
                If   ret   < >   -1   Then
                        "删除指定字符串(通过索引)
                        SendMessage   Me.cbData.hwnd,   CB_DELETESTRING,   ret,   ByVal   0&
                        "更新记数(因为删除一字符串后索引就小了一位所以把最大的值删除掉)
                        SendMessage   Me.cbInsert.hwnd,   CB_DELETESTRING,   CLng(cbInsert.ListCount   -   1),   ByVal   0&
                Else
                        MsgBox   "你需要删除的字符串在COMBOBOX中不存在!!",   vbInformation,   "提示"
                End   If
        End   If
End   Sub

Private   Sub   cmdInsert_Click()
        "插入字符串到ComboBox中索引为cbInsert.Text位置
        If   Trim(textData.Text)   < >   ""   Then
                "插入指定字符串到索引位置
                Call   SendMessage(Me.cbData.hwnd,   CB_INSERTSTRING,   CLng(cbInsert.Text),   ByVal   textData.Text)
                "更新索引记数(因为插入一字符串索引总数增加了)                       因为索引是从0开始所以这里要减去1
                Call   SendMessage(Me.cbInsert.hwnd,   CB_ADDSTRING,   0,   ByVal   CStr(cbData.ListCount   -   1))
        End   If
End   Sub

Private   Sub   Form_Initialize()
        "显示XP风格
        InitCommonControls
End   Sub

Private   Sub   Form_KeyDown(KeyCode   As   Integer,   Shift   As   Integer)
        Dim   i   As   Long,   j   As   Long
        If   KeyCode   =   vbKeyF3   Then
                "获取当前选中的索引
                i   =   SendMessage(Me.cbData.hwnd,   CB_GETCURSEL,   0,   ByVal   0&)
                "从当前选中的索引开始向下查找类似字符串
                j   =   SendMessage(Me.cbData.hwnd,   CB_FINDSTRING,   i,   ByVal   textData.Text)
                "如果查找的结果索引和当前索引不一样证明存在类似字符串
                If   j   < >   i   Then
                        "这两句可以互换
                        selectIndex   =   SendMessage(Me.cbData.hwnd,   CB_SETCURSEL,   j,   ByVal   0&)
                        "selectIndex   =   SendMessage(Me.cbData.hwnd,   CB_SELECTSTRING,   i,   ByVal   textData.Text)
                End   If
        End   If
End   Sub

"******************************************************************************************************************
Private   Sub   Form_Load()
        Dim   strTmp   As   String,   hFile   As   Integer,   i   As   Integer
        hFile   =   FreeFile
        "加载测试对象
        Open   App.Path   &   "\test.txt"   For   Input   As   #hFile
        Do   While   Not   EOF(hFile)
                Line   Input   #hFile,   strTmp
                If   Trim(strTmp)   < >   ""   Then
                        "依次插入索引值从0开始
                        Call   SendMessage(Me.cbInsert.hwnd,   CB_ADDSTRING,   0,   ByVal   CStr(i))
                        Me.cbData.AddItem   strTmp
                        i   =   i   +   1
                End   If
        Loop
        Close   #hFile
        cbData.ListIndex   =   0
        cbInsert.ListIndex   =   0
End   Sub

Private   Sub   textData_Change()
        "当textData内容发生变化时查找字符串
        Dim   ret   As   Long
        "当输入字符时进行查找
        If   Trim(textData.Text)   < >   ""   Then
                ret   =   SendMessage(Me.cbData.hwnd,   CB_FINDSTRING,   -1,   ByVal   textData.Text)
                If   ret   < >   -1   Then
                        "如果查找到了先使COMBOBOX下拉
                        SendMessage   Me.cbData.hwnd,   CB_SHOWDROPDOWN,   1,   0&
                        "选定查找到的字符串(这两句可以互换)
                        selectIndex   =   SendMessage(Me.cbData.hwnd,   CB_SELECTSTRING,   -1,   ByVal   textData.Text)
                        "selectIndex   =   SendMessage(Me.cbData.hwnd,   CB_SETCURSEL,   ret,   ByVal   0&)
                End   If
        End   If
End   Sub

Private   Sub   textData_KeyDown(KeyCode   As   Integer,   Shift   As   Integer)
        "当按下回车时选定字符串
        If   KeyCode   =   vbKeyReturn   Then
                "使下拉结束
                SendMessage   Me.cbData.hwnd,   CB_SHOWDROPDOWN,   0,   0&
                "选定指定字符串
                SendMessage   Me.cbData.hwnd,   CB_SETCURSEL,   selectIndex,   ByVal   0&
        End   If
End   Sub

posted @ 2008-10-22 16:32  willen  阅读(1910)  评论(0编辑  收藏  举报