| '----- Class: clsACCombo
Option Explicit
Private m_col As Collection
Private WithEvents m_cbo As ComboBox
Private m_bEnabled As Boolean
Private m_bLastKeyDel As Boolean
Private m_sLast As String
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As _
String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal _
hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As _
Long) As Long
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 Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Public Property Get Enabled() As Boolean
Enabled = m_bEnabled
End Property
Public Property Let Enabled(bNew As Boolean)
Debug.Assert bNew And Not (m_col Is Nothing)
Debug.Assert bNew And Not (m_cbo Is Nothing)
m_bEnabled = bNew
End Property
Public Property Get ComboBox() As ComboBox
Set ComboBox = m_cbo
End Property
Public Property Set ComboBox(cboNew As ComboBox)
Set m_cbo = cboNew
End Property
Public Property Get Collection() As Collection
Set Collection = m_col
End Property
Public Property Set Collection(colNew As Collection)
Set m_col = colNew
End Property
Public Sub ResortCollection()
Debug.Assert Not (m_col Is Nothing)
If m_col.Count <= 1 Then
Exit Sub
End If
Dim i As Long
Dim j As Long
Dim nGap As Long
Dim bResult As Boolean
Dim tmp
Dim tmp2
nGap = m_col.Count / 2
Do While nGap > 0
For i = nGap To m_col.Count - 1
tmp = m_col(i + 1)
j = i
bResult = (StrComp(tmp, m_col(j - nGap + 1), _
vbBinaryCompare) = -1)
Do While j >= nGap And bResult
tmp2 = m_col(j - nGap + 1)
m_col.Remove j + 1
If j + 1 > m_col.Count Then
m_col.Add tmp2
Else
m_col.Add tmp2, , j + 1
End If
j = j - nGap
If j >= nGap Then
bResult = (StrComp(tmp, m_col(j - nGap + 1), _
vbBinaryCompare) = -1)
End If
Loop
m_col.Remove j + 1
If j + 1 > m_col.Count Then
m_col.Add tmp
Else
m_col.Add tmp, , j + 1
End If
Next
nGap = nGap / 2
Loop
End Sub
Private Sub m_cbo_Change()
Dim nStart As Long
Dim nEnd As Long
Dim sTemp As String
Dim bFix As Boolean
Dim bNewState As Boolean
Dim bOldState As Boolean
Dim bAddItems As Boolean
Dim bCompleted As Boolean
Dim i As Long
If Not m_bEnabled Or m_bLastKeyDel Then
Exit Sub
End If
If m_cbo.SelStart <> Len(m_cbo.Text) Then
Exit Sub
End If
If m_cbo.Text = "" Then
Exit Sub
End If
bOldState = (SendMessage(m_cbo.hwnd, &H157, 0, ByVal 0) <> 0)
If bOldState Then
ShowWindow FindComboLBox, SW_HIDE
End If
bAddItems = True
If LCase(Mid(m_cbo.Text, 1, Len(m_sLast))) = m_sLast Then
If m_sLast <> "" Then
bAddItems = False
For i = m_cbo.ListCount - 1 To 0 Step -1
If LCase(Mid(m_cbo.List(i), 1, Len(m_cbo.Text))) <> _
LCase(m_cbo.Text) Then
m_cbo.RemoveItem i
End If
Next
End If
End If
Dim vItem As Variant
Dim sContain As String
sContain = LCase(m_cbo.Text)
bCompleted = False
If bAddItems Then
While m_cbo.ListCount > 0
m_cbo.RemoveItem 0
Wend
End If
For Each vItem In m_col
If Mid(LCase(vItem), 1, Len(sContain)) = sContain Then
If Not bCompleted Then
bCompleted = True
m_cbo = m_cbo & Mid(vItem, Len(sContain) + 1)
m_cbo.SelStart = Len(sContain)
m_cbo.SelLength = Len(m_cbo) - Len(sContain)
End If
If bAddItems Then
m_cbo.AddItem vItem
Else
Exit For
End If
End If
Next
bNewState = (m_cbo.ListCount <> 0)
Do While m_cbo.ListCount < 8
m_cbo.AddItem ""
Loop
If bOldState <> bNewState Then
bFix = True
End If
If bFix Then
sTemp = m_cbo.Text
nStart = m_cbo.SelStart
nEnd = m_cbo.SelLength
SendMessage m_cbo.hwnd, &H14F, bNewState, ByVal 0
m_cbo.Text = sTemp
m_cbo.SelStart = nStart
m_cbo.SelLength = nEnd
End If
m_sLast = LCase(m_cbo.Text)
If bOldState And bNewState Then
ShowWindow FindComboLBox, SW_NORMAL
End If
End Sub
Private Sub m_cbo_KeyDown(KeyCode As Integer, Shift As Integer)
If Not m_bEnabled Then
Exit Sub
End If
If KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
m_bLastKeyDel = True
Else
m_bLastKeyDel = False
End If
End Sub
Private Function FindComboLBox() As Long
Static hWndMyCombo As Long
If hWndMyCombo <> 0 Then
FindComboLBox = hWndMyCombo
Exit Function
End If
Dim pidThis As Long
Dim pidRemote As Long
Dim hWndCombo As Long
pidThis = GetCurrentProcessId
hWndCombo = FindWindowEx(0, hWndCombo, "ComboLBox", vbNullString)
Do Until hWndCombo = 0 Or hWndMyCombo <> 0
GetWindowThreadProcessId hWndCombo, pidRemote
If pidRemote = pidThis And IsWindowVisible(hWndCombo) Then
hWndMyCombo = hWndCombo
End If
hWndCombo = FindWindowEx(0, hWndCombo, "ComboLBox", _
vbNullString)
Loop
FindComboLBox = hWndMyCombo
End Function
'----- End of class
|