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

来源：互联网发布：最好的直销软件编辑：程序博客网时间：2024/05/16 06:47

最近经常有人问我这个问题索引就把代码贴出来大家一起共享吧！其实难度很低就是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