求一控件,能自够动定位的Combo!

[wumylove1234]

因为项目比较多,而且项目都带编号的,想实现输编号自动定位到Combo上.弄了几个控件都没有实现,我记得VB的ComboBox加一个API可以实现.但是一时又找不到代码了..


请问大家在做这个时,都用了哪个控件?万分感谢.小弟因长时间不登录,所以可用分很少,不好意思了.

[wumylove1234]

顶

[vansoft]

代碼在家裏的電腦裏。

[lsftest]

Combo的自动查询技术

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
As Long
Public Const CB_FINDSTRING = &H14C
Private Sub Combo1_Change()
Dim iStart As Integer
Dim sString As String
Static iLeftOff As Integer
iStart = 1
iStart = Combo1.SelStart
If iLeftOff <> 0 Then
Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If
sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd,B_FINDSTRING, -1, ByVal CStr(
Left( ombo1.Text, iStart)))
　
If Combo1.ListIndex = -1 Then
iLeftOff = Len(sString)
combo1.Text = sString
End If
Combo1.SelStart = iStart
iLeftOff = 0
End Sub
静态变量 iLeftOff 指定了字符长度。

[lsftest]

上面的代码漏了几个字母，楼主自己添上吧。。。。

[wumylove1234]

难道VB中好的控件就没有了吗?

除了自动查找,我还要实现在我打键盘的时候下拉列表自动下拉!

[faysky2]

如果想打开下拉列表，使用：
SendMessage Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
如果想关闭下拉列表，使用：
SendMessage Combo1.hwnd, CB_SHOWDROPDOWN, 0, ByVal 0&

[fongzl]

奇怪，楼上说的方法我用了怎么没效果阿？

[laviewpbt]

Dim blnAuto As Boolean 'Keeps the autocomplete functions from
'triggering the Change event

Private Sub cboAuto_Change()
Dim strPart As String, iLoop As Integer, iStart As Integer, strItem As String
'don't do if no text or if change was made by autocomplete coding
If Not blnAuto And cboAuto.Text <> "" Then
'save the selection start point (cursor position)
iStart = cboAuto.SelStart
'get the part the user has typed (not selected)
strPart = Left$(cboAuto.Text, iStart)
For iLoop = 0 To cboAuto.ListCount - 1
'compare each item to the part the user has typed,
'"complete" with the first good match
strItem = UCase$(cboAuto.List(iLoop))
If strItem Like UCase$(strPart & "*") And _
strItem <> UCase$(cboAuto.Text) Then
'partial match but not the whole thing.
'(if whole thing, nothing to complete!)
blnAuto = True
cboAuto.SelText = Mid$(cboAuto.List(iLoop), iStart + 1) 'add on the new ending
cboAuto.SelStart = iStart 'reset the selection
cboAuto.SelLength = Len(cboAuto.Text) - iStart
blnAuto = False
Exit For
End If
Next iLoop
End If
End Sub

Private Sub cboAuto_KeyDown(KeyCode As Integer, Shift As Integer)
'Unless we watch out for it, backspace or delete will just delete
'the selected text (the autocomplete part), so we delete it here
'first so it doesn't interfere with what the user expects
If KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
blnAuto = True
cboAuto.SelText = ""
blnAuto = False
ElseIf KeyCode = vbKeyReturn Then 'Accept autocomplete on 'Enter' keypress
cboAuto_LostFocus
'the following causes the item to be selected and
'the cursor placed at the end:
cboAuto.SelStart = Len(cboAuto.Text)

'This would select the whole thing instead:
'cboAuto.SelLength = Len(cboAuto.Text)

'alternatively, you could move the focus to the next control here
End If
End Sub

Private Sub cboAuto_LostFocus()
Dim iLoop As Integer
'Match capitalization if item entered is one on the list
If cboAuto.Text <> "" Then
For iLoop = 0 To cboAuto.ListCount - 1
If UCase$(cboAuto.List(iLoop)) = UCase$(cboAuto.Text) Then
blnAuto = True
cboAuto.Text = cboAuto.List(iLoop)
blnAuto = False
Exit For
End If
Next iLoop
End If
End Sub

Private Sub Form_Load()
'add a bunch of items. cboAuto's Sorted property is
'True so they will end up in order
cboAuto.AddItem "Apples"
cboAuto.AddItem "Oranges"
cboAuto.AddItem "Bananas"
cboAuto.AddItem "Pears"
cboAuto.AddItem "Peaches"
cboAuto.AddItem "Pineapples"
cboAuto.AddItem "Grapes"
cboAuto.AddItem "Blueberries"
cboAuto.AddItem "Raspberries"
cboAuto.AddItem "Blackberries"
cboAuto.AddItem "Papaya"
cboAuto.AddItem "Kiwi"
cboAuto.AddItem "Watermelon"
cboAuto.AddItem "Guava"
End Sub

[faysky2]

to : fongzl(也许我应该开心一些......)

函数跟常数都需要声明的

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 CB_SHOWDROPDOWN = &H14F

Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii <> 13 Then
SendMessage Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
Else
SendMessage Combo1.hwnd, CB_SHOWDROPDOWN, 0, ByVal 0&
End If
End Sub

[vansoft]

Option Explicit
Dim strCombo As String
Const WM_SETREDRAW = &HB
Const KEY_A = 65
Const KEY_Z = 90
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 Sub combo1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim x%
Dim strTemp$
Dim nRet&

If KeyCode >= KEY_A And KeyCode <= KEY_Z Then
'only look at letters A-Z
strTemp = Combo1.Text
If Len(strTemp) = 1 Then strCombo = strTemp
nRet& = SendMessage(Combo1.hwnd, WM_SETREDRAW, False, 0&)
For x = 0 To (Combo1.ListCount - 1)
If UCase((strTemp & Mid$(Combo1.List(x), Len(strTemp) + 1))) = UCase(Combo1.List(x)) Then
Combo1.ListIndex = x
Combo1.Text = Combo1.List(x)
Combo1.SelStart = Len(strTemp)
Combo1.SelLength = Len(Combo1.Text) - (Len(strTemp))
strCombo = strCombo & Mid$(strTemp, Len(strCombo) + 1)
Exit For
Else
If InStr(UCase(strTemp), UCase(strCombo)) Then
strCombo = strCombo & Mid$(strTemp, Len(strCombo) + 1)
Combo1.Text = strCombo
Combo1.SelStart = Len(Combo1.Text)
Else
strCombo = strTemp
End If
End If
Next
nRet& = SendMessage(Combo1.hwnd, WM_SETREDRAW, True, 0&)
End If
End Sub

Private Sub Form_Load()
Combo1.AddItem "AAAAAAAA"
Combo1.AddItem "ABBBBBBB"
Combo1.AddItem "ABCCCCCC"
Combo1.AddItem "ABCDDDDD"
Combo1.AddItem "ABCDEEEE"
Combo1.AddItem "ABCDEFFF"
Combo1.AddItem "ABCDEFGG"
Combo1.AddItem "ABCDEFGH"
End Sub

窗体上放一个ComboBox控件即可。