Enter не заносит выделенное значение списка в Text ComboBox-а

Если в открытом списке ComboBox-а выбирается строка мышью
!без клика!, то нажатие Enter не заносит выделенное значение
списка в Text ComboBox-а.
Решение данной проблемы:

Вопрос к ALL
Может есть способ лучше?

0

Делай с этим, что хочешь, но это почти Аксесовский комбобокс.
По крайней мере потребности некоторых дам он выполнил.

Option Explicit

Private m_bNoise As Boolean

'*** Const for ComboBox
Private Const CB_SETEXTENDEDUI& = &H155
Private Const CB_FINDSTRING& = &H14C
Private Const CB_FINDSTRINGEXACT& = &H158
Private Const CB_LIMITTEXT& = &H141
Private Const CB_GETDROPPEDSTATE& = &H157
Private Const CB_SHOWDROPDOWN& = &H14F
Private Const CB_SELECTSTRING& = &H14D

'*** Function for ComboBox
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

'*** Event for UserControl
Event NotInList()

Private Sub Combo_Click()

If m_bNoise Then
m_bNoise = False
Else
SendKeys ('{TAB}')
End If

End Sub

Private Sub Combo_KeyDown(KeyCode As Integer, Shift As Integer)

m_bNoise = True

If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Or _
KeyCode = vbKeyPageDown Or KeyCode = vbKeyPageUp Then
Exit Sub
End If

If KeyCode = 8 Or KeyCode = 46 Then 'Backspace or Delete
Combo.Text = ''
Exit Sub
End If

Dim bLen As Boolean
Dim sVal As String
Dim lIndex As Long

With Combo
sVal = FirstChar$(.Text)
bLen = (Len(sVal) > 0)

If KeyCode = vbKeyReturn And bLen Then
lIndex = SendMessage(.hWnd, CB_FINDSTRINGEXACT&, -1, ByVal sVal)

If lIndex& >= 0 Then

'If DroppedState = 1 Then SendMessage .hWnd, CB_SHOWDROPDOWN&, 0&, 0&

.ListIndex = lIndex

Else

RaiseEvent NotInList

.Refresh

If Len(.Text) = 0 Then Exit Sub

.ListIndex = SendMessage(.hWnd, CB_SELECTSTRING, -1, ByVal sVal)

End If

SendKeys ('{TAB}')

End If

End With

End Sub

Private Sub Combo_Change()

Dim lIndex As Long
Dim sText As String
Dim iPos As Integer

With Combo
sText$ = .Text
lIndex& = SendMessage(.hWnd, CB_FINDSTRING&, -1&, ByVal sText$)

If lIndex& = -1 Then
iPos = 0
Else
iPos = .SelStart
.ListIndex = lIndex&
.SelStart = iPos
.SelLength = Len(.Text) - iPos
End If

End With

m_bNoise = True

End Sub

Private Sub Combo_DropDown()
m_bNoise = False
End Sub

Private Sub UserControl_Initialize()
SendMessage Combo.hWnd, CB_SETEXTENDEDUI&, 1&, 0&
SendMessage Combo.hWnd, CB_LIMITTEXT&, 30&, 0&
m_bNoise = True
End Sub

Private Sub UserControl_Resize()
With Combo
.Move 0, 0
.Width = UserControl.Width
UserControl.Height = .Height
End With
End Sub

Private Function FirstChar(sVal As String) As String

Dim strTemp As String

strTemp$ = Trim$(sVal)
FirstChar$ = UCase$(Left$(sVal, 1)) + Mid$(sVal, 2)

End Function

'Private Function DroppedState() As Long
' DroppedState = SendMessage(Combo.hWnd, CB_GETDROPPEDSTATE&, 0&, 0&)
'End Function

Public Property Get CboBox() As ComboBox
S

Привет prince.
Благодарю за оказанное внимание.
Хотя примеры не пересекаются с улучшением моей
проблемы (вопросом), они когда ни будь,
пригодятся.
Для кучи кину ещё примерчик:

Иногда требуется юзера заставить обязательно
ввести значение в ComboBox и при этом ещё и
правильное значение (ключевое поле).
Вроде как можно написать процедурку на событие
Form_QueryUnload, но проблема в том что
событие Data1_Validate (если ComboBox подключен
к Data) происходит ранше чем Form_QueryUnload
(при попытке юзера закрыть форму).

Данный примем решает эту проблему.
Пример сравнивает введённое значение
в ComboBox-е с значениями List-а ComboBox-а
и если оно не сходится то не даёт закрыть
форму нажатием на X или по ALT + F4 до события
Data1_Validate, и при этом выводит сообщение.
(Хотя можно преобразовать пример под алтернативу
события Form_QueryUnload и использовать в других
целях).

ВНИМАНИЕ: форма закроется только при правильном
значенни взятом из списка ComboBox-а !!!

Кидаем на форму ComboBox.

Заносим в форму:

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 50
'Это и есть значения ComboBox-а
Combo1.AddItem i, i
Next i
OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf _
SubClass1_WndMessage
End Sub
-----------------------------------------------------
Заносим в модуль:

Private Declare Function CallWindowProc Lib 'user32' Alias _
'CallWindowProcA' (ByVal lpPrevWndFunc As Long, ByVal hwnd _
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal _
lParam As Long) As Long
Public Declare Function GetWindowLong Lib 'user32' Alias _
'GetWindowLongA' (ByVal hwnd As Long, ByVal nIndex As Long) _
As Long
Public Declare Function SetWindowLong Lib 'user32' Alias _
'SetWindowLongA' (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetTopWindow 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
Public Const GWL_WNDPROC = (-4)
Private Const EM_UNDO = &HC7
Public OldWindowProc As Long
Public Function SubClass1_WndMessage(ByVal hwnd As _
OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As _
OLE_HANDLE, ByVal lp As Long) As Long
If wp = 61536 Then
Dim A As Boolean
Dim IndexStr As Integer
With Form1.Combo1
For IndexStr = 0 To .ListCount - 1
If .List(IndexStr) = .Text Then A = True: Exit For
Next IndexStr
If Not A Then
Dim B As String
Dim C As Long
If Form1.Combo1 Like '*[ ]' Or Form1.Combo1 = '' Then
B = 'Введите № группы'
C = vbInformation
Else
B = 'Нет такой группы: ' & Form1.Combo1
C = vbExclamation
End If
MsgBox B, vbOKOnly + C, Form1.Caption
SendMessage GetTopWindow(Form1.hwnd), EM_UNDO, 0, 0
.SetFocus
wp = 0
End If
End With
End If
SubClass1_WndMessage = CallWindowProc(OldWindowProc, _
hwnd, Msg, wp, lp)
End Function

0