Option Explicit
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Const CB_SHOWDROPDOWN = &H14F
Private Const CB_SETTOPINDEX = &H15C
Private Const CB_GETDROPPEDSTATE = &H157
Private PYList() As String
'初始化
Private Sub Form_Load()
Dim i As Integer
'Combo
With Combo1
For i = 1 To 10
.AddItem i
Next
.AddItem "北京中关村"
.AddItem "大连联盛座"
.AddItem "河北石家庄"
.AddItem "河北玉晶玻璃制品有限公司"
For i = 1 To 10
.AddItem i + 10
Next
End With
'拼音列表
InitPYList Combo1
End Sub
'初始cboBox的拼音列表
Private Sub InitPYList(ByRef cboBox As ComboBox)
Dim i As Integer
Dim tCount As Integer
tCount = cboBox.ListCount - 1
Erase PYList
ReDim PYList(tCount)
With cboBox
.Enabled = False
For i = 0 To tCount
PYList(i) = GetPY(.List(i))
Next
.Enabled = True
End With
End Sub
'取字符串拼音首字
Function GetPY(ByVal x As String) As String
Dim i As Integer
Dim j As Integer
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
GetPY = ""
For j = 1 To Len(x)
For i = 1 To 24
If Asc(Mid(x, j, 1)) >= Asc(Mid(hanzi, i, 1)) And Asc(Mid(x, j, 1)) GetPY = GetPY & Mid(hanzi, 24 + i, 1)
End If
Next
Next
End Function
'查找
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Combo1.Text = Combo1.List(Val(Combo1.Tag))
Else
FindPY Combo1.Text, Combo1
End If
End Sub
'找出拼音串tS
Private Sub FindPY(ByVal tS As String, ByRef cboBox As ComboBox)
Dim i As Integer
Dim tL As Integer
tS = UCase(tS)
tL = Len(tS)
For i = 0 To UBound(PYList)
If tS = Left(PYList(i), tL) Then '找到第一个匹配的
Me.Caption = i
'下拉列表
If Not SendMessage(cboBox.hwnd, CB_GETDROPPEDSTATE, 0, 0) Then
SendMessage cboBox.hwnd, CB_SHOWDROPDOWN, True, 0
End If
'定位
cboBox.Tag = i
SendMessage cboBox.hwnd, CB_SETTOPINDEX, i, 0
Exit Sub
End If
Next
End Sub