Нужен алгоритм для комбобокса
Суть в следующем. Есть комбобокс. Он заполнется какими-то текстовыми значениями. Нужно, чтобы когда пользователь устанавливает курсор в комбобокс и начинает набирать текст, автоматом подставлялся текст, который есть в комбобоксе и начинается с введённой комбинации. При этом нужно, чтобы ListIndex у комбобокса изменялся адекватно подставленному значению. Как этот алгоритм реализовать в логике, я примерно представляю, но никто кусок кода не скинет? (Пристите меня за мою наглость).
====Help=====
Match Entry Property
Returns or sets a value indicating how a ListBox or ComboBox searches its list as the user types.
Syntax
object.MatchEntry [= fmMatchEntry]
The MatchEntry property syntax has these parts:
Part Description
object Required. A valid object.
fmMatchEntry Optional. The rule used to match entries in the list.
Settings
The settings for fmMatchEntry are:
Constant Value Description
fmMatchEntryFirstLetter 0 Basic matching. The control searches for the next entry that starts with the character entered. Repeatedly typing the same letter cycles through all entries beginning with that letter.
FmMatchEntryComplete 1 Extended matching. As each character is typed, the control searches for an entry matching all characters entered (default).
FmMatchEntryNone 2 No matching.
Remarks
The MatchEntry property searches entries from the TextColumn property of a ListBox or ComboBox.
The control searches the column identified by TextColumn for an entry that matches the user's typed entry. Upon finding a match, the row containing the match is selected, the contents of the column are displayed, and the contents of its BoundColumn property become the value of the control. If the match is unambiguous, finding the match initiates the Click event.
The control initiates the Click event as soon as the user types a sequence of characters that match exactly one entry in the list. As the user types, the entry is compared with the current row in the list and with the next row in the list. When the entry matches only the current row, the match is unambiguous.
In Microsoft Forms, this is true regardless of whether the list is sorted. This means the control finds the first occurrence that matches the entry, based on the order of items in the list. For example, entering either «abc» or «bc» will initiate the Click event for the following list:
abcde
bcdef
abcxyz
bchij
Note that in either case, the matched entry is not unique; however, it is sufficiently different from the adjacent entry that the control interprets the match as unambiguous and initiates the Click event.
Copyright(c) 1996 Microsoft Corporation.
=============
Так ведь для этого у обычного комбобокса есть свойство .MatchEntry
====Help=====
Match Entry Property
Returns or sets a value indicating how a ListBox or ComboBox searches its list as the user types.
Syntax
object.MatchEntry [= fmMatchEntry]
The MatchEntry property syntax has these parts:
Part Description
object Required. A valid object.
fmMatchEntry Optional. The rule used to match entries in the list.
Settings
The settings for fmMatchEntry are:
Constant Value Description
fmMatchEntryFirstLetter 0 Basic matching. The control searches for the next entry that starts with the character entered. Repeatedly typing the same letter cycles through all entries beginning with that letter.
FmMatchEntryComplete 1 Extended matching. As each character is typed, the control searches for an entry matching all characters entered (default).
FmMatchEntryNone 2 No matching.
Remarks
The MatchEntry property searches entries from the TextColumn property of a ListBox or ComboBox.
The control searches the column identified by TextColumn for an entry that matches the user's typed entry. Upon finding a match, the row containing the match is selected, the contents of the column are displayed, and the contents of its BoundColumn property become the value of the control. If the match is unambiguous, finding the match initiates the Click event.
The control initiates the Click event as soon as the user types a sequence of characters that match exactly one entry in the list. As the user types, the entry is compared with the current row in the list and with the next row in the list. When the entry matches only the current row, the match is unambiguous.
In Microsoft Forms, this is true regardless of whether the list is sorted. This means the control finds the first occurrence that matches the entry, based on the order of items in the list. For example, entering either «abc» or «bc» will initiate the Click event for the following list:
abcde
bcdef
abcxyz
bchij
Note that in either case, the matched entry is not unique; however, it is sufficiently different from the adjacent entry that the control interprets the match as unambiguous and initiates the Click event.
Copyright(c) 1996 Microsoft Corporation.
=============
Спасибо большое, но это, наверное, в VBA. В VB6 я такого свойства не нашёл. Дело в том, что такая задача уже вставала передо мною, и я её решал с помощью прцедурки. :{
Спасибо большое, но это, наверное, в VBA. В VB6 я такого свойства не нашёл. Дело в том, что такая задача уже вставала передо мною, и я её решал с помощью прцедурки. :{
VBA использует контролы из библиотеки MSForms в References называется - Microsoft Forms 2.0 Object Library, ты тоже можешь в VB6 подключить ее и использовать их контролы. Везде где будет стоять Office твоя прога будет работать, а если нет Office, то файл FM20.DLL надо будет с собой таскать.
VBA использует контролы из библиотеки MSForms в References называется - Microsoft Forms 2.0 Object Library, ты тоже можешь в VB6 подключить ее и использовать их контролы. Везде где будет стоять Office твоя прога будет работать, а если нет Office, то файл FM20.DLL надо будет с собой таскать.
Это, конечно, можно было бы использовать, тем более, что всё равно SetUp для программы будет делаться, но беда в том, что интерфейс почти готов, и менять контролы по всем формам -очень тяжко. Тем более, что прийдётся рубить и собственные, уже готовые контролы, в которых описаны горы свойств этих несчастных комбобоксов. И в эти контролы проще всего просто добавить процедурку, чем менять интерфейс.:{
Это, конечно, можно было бы использовать, тем более, что всё равно SetUp для программы будет делаться, но беда в том, что интерфейс почти готов, и менять контролы по всем формам -очень тяжко. Тем более, что прийдётся рубить и собственные, уже готовые контролы, в которых описаны горы свойств этих несчастных комбобоксов. И в эти контролы проще всего просто добавить процедурку, чем менять интерфейс.:{
Можно же сделать это вручную, если никак не получается поменять объекты. При событии Change проверять на соответствие... если грамотно сделать, то скорость будет высокой, а текст небольшой и удобный... Я когда-то примерно так делал, тоолько не с этим объектом.
Можно же сделать это вручную, если никак не получается поменять объекты. При событии Change проверять на соответствие... если грамотно сделать, то скорость будет высокой, а текст небольшой и удобный... Я когда-то примерно так делал, тоолько не с этим объектом.
Ладно. напишу сам, благо в субботу на работу вышел. А когда всё закончу - сюда выложу, дабы всем остальным проще было.:)
Ладно. напишу сам, благо в субботу на работу вышел. А когда всё закончу - сюда выложу, дабы всем остальным проще было.:)
Вроде как написал для комбобокса процедурку. Пока не тестировал. Скидываю её сюда. Если у кого будут идеи, буду очень признателен :)
Public Sub SelectCbx(ByVal Cbx As ComboBox, Txt As String, Optional Refr As Boolean)
'МАХ процедура. которая должна находить в комбобоксе введённый текст и _
подставлять в него значения, ну, короче, понятно (срабатывает, когда чувак _
набирает в комбике текст, а комбик сам под него подставляется) _
Получает на вход комбобокс и символ текста пользователя. _
Опционально получает команду на очистку
On Error GoTo ErrHnd 'МАХ в случае ошибки переходим к собственному обработчику ошибок
Static OldCbx As ComboBox 'МАХ хранит комбобокс
Static CbLetter As String 'МАХ хранит текст комбобокса
Dim I As Long 'МАХ счётчик циклов
If Not Refr Then 'МАХ проверяем необходимость рефреша (если комбик, например, теряет фокус)
'МАХ проверка, тот ли комбобокс
If OldCbx <> Cbx Then
OldCbx = Cbx
CbLetter = vbNullString
End If
CbLetter = CbLetter & Txt 'МАХ создаём поисковый текст
For I = 0 To OldCbx.ListCount 'МАХ в цикле ищем текст, начинающийся с введённых символов
If Left(Trim(OldCbx.ItemData(I)), Len(Trim(CbLetter))) = CbLetter Then
OldCbx.ListIndex = I 'МАХ подставляем итем комбобокса
Exit For 'МАХ досрочно выходим из цикла
End If
Next
Else
'МАХ если рефрешим, сбрасываем все переменные
Set OldCbx = Nothing
CbLetter = vbNullString
End If
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrModGlobalProcedures.SelectCbx Комбобокс " & Cbx.Name & " Текст " & Txt
End Sub
Вроде как написал для комбобокса процедурку. Пока не тестировал. Скидываю её сюда. Если у кого будут идеи, буду очень признателен :)
Public Sub SelectCbx(ByVal Cbx As ComboBox, Txt As String, Optional Refr As Boolean)
'МАХ процедура. которая должна находить в комбобоксе введённый текст и _
подставлять в него значения, ну, короче, понятно (срабатывает, когда чувак _
набирает в комбике текст, а комбик сам под него подставляется) _
Получает на вход комбобокс и символ текста пользователя. _
Опционально получает команду на очистку
On Error GoTo ErrHnd 'МАХ в случае ошибки переходим к собственному обработчику ошибок
Static OldCbx As ComboBox 'МАХ хранит комбобокс
Static CbLetter As String 'МАХ хранит текст комбобокса
Dim I As Long 'МАХ счётчик циклов
If Not Refr Then 'МАХ проверяем необходимость рефреша (если комбик, например, теряет фокус)
'МАХ проверка, тот ли комбобокс
If OldCbx <> Cbx Then
OldCbx = Cbx
CbLetter = vbNullString
End If
CbLetter = CbLetter & Txt 'МАХ создаём поисковый текст
For I = 0 To OldCbx.ListCount 'МАХ в цикле ищем текст, начинающийся с введённых символов
If Left(Trim(OldCbx.ItemData(I)), Len(Trim(CbLetter))) = CbLetter Then
OldCbx.ListIndex = I 'МАХ подставляем итем комбобокса
Exit For 'МАХ досрочно выходим из цикла
End If
Next
Else
'МАХ если рефрешим, сбрасываем все переменные
Set OldCbx = Nothing
CbLetter = vbNullString
End If
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrModGlobalProcedures.SelectCbx Комбобокс " & Cbx.Name & " Текст " & Txt
End Sub
Да, забыл. Для корректности нужно LCase делать, чтобы прописные и строчные буквы не различались
Да, забыл. Для корректности нужно LCase делать, чтобы прописные и строчные буквы не различались
Всё, вроде как отточил код. Выкладываю описание ряда нужных процедур
Private Sub CbCntHtl_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
'МАХ обрабатываем введённый символ
On Error GoTo ErrHnd 'МАХ в случае ошибки передаём управление обработчику
If KeyCode = 9 Or KeyCode = 46 Or KeyCode = 8 Or KeyCode = 27 Then
SelectCbx CbCntHtl(Index), vbNullString, 0, True 'МАХ сбросим комбобокс
End If
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrmMenu.CbCntHtl_KeyDown Комбобокс с индексом № " & Index & " Код клавиши " & KeyCode
End Sub
Private Sub CbCntHtl_KeyPress(Index As Integer, KeyAscii As Integer)
'МАХ отлавливаем нажатие кнопки пользователем (для подстановки)
On Error GoTo ErrHnd 'МАХ в случае ошибки передаём управление обработчику
If KeyAscii <> 9 And KeyAscii <> 8 And KeyAscii <> 27 And KeyAscii <> 13 Then
SelectCbx CbCntHtl(Index), Chr$(KeyAscii), CbCntHtl(Index).ListIndex, False
End If
KeyAscii = 0 'МАХ стираем символ
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrmMenu.CbCntHtl_KeyPress Комбобокс с индексом № " & Index & " Код клсвиши " & KeyAscii
End Sub
Private Sub CbCntHtl_LostFocus(Index As Integer)
'МАХ сбрасываем подстановщик комбобокса
On Error GoTo ErrHnd 'МАХ в случае ошибки передаём управление обработчику
SelectCbx CbCntHtl(Index), vbNullString, 0, True
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrmMenu.CbCntHtl_LostFocus Комбобокс с индексом № " & Index
End Sub
Public Sub SelectCbx(ByVal Cbx As Object, Txt As String, LisInd As Long, Optional Refr As Boolean)
'МАХ процедура. которая должна находить в комбобоксе введённый текст и _
подставлять в него значения, ну, короче, понятно (срабатывает, когда чувак _
набирает в комбике текст, а комбик сам под него подставляется) _
Получает на вход комбобокс и символ текста пользователя, текущий лист индекс. _
Опционально получает команду на очистку
On Error GoTo ErrHnd 'МАХ в случае ошибки переходим к собственному обработчику ошибок
Static OldCbx As String 'МАХ хранит комбобокс
Static CbLetter As String 'МАХ хранит текст комбобокса
Dim I As Long 'МАХ счётчик циклов
If Not Refr Then 'МАХ проверяем необходимость рефреша (если комбик, например, теряет фокус)
'МАХ проверка, тот ли комбобокс
If OldCbx = vbNullString Or OldCbx <> Cbx.Name Then
OldCbx = Cbx.Name
CbLetter = vbNullString
End If
CbLetter = CbLetter & Txt 'МАХ создаём поисковый текст
For I = 0 To Cbx.ListCount - 1 'МАХ в цикле ищем текст, начинающийся с введённых символов
Cbx.ListIndex = I 'МАХ устанавливаем лист индекс
If LCase(Left(Trim(Cbx.Text), Len(Trim(CbLetter)))) = LCase(CbLetter) Then
DoEvents
Cbx.ListIndex = I 'МАХ подставляем итем комбобокса
DoEvents
Cbx.Refresh
DoEvents
LisInd = I
Exit For 'МАХ досрочно выходим из цикла
End If
Cbx.ListIndex = LisInd 'МАХ возвращаем лист индекс
Next
Else
'МАХ если рефрешим, сбрасываем все переменные
OldCbx = vbNullString
CbLetter = vbNullString
End If
Exit Sub
ErrHnd: 'МАХ область обработки ошибок
'МАХ передача управления процедуры ведения лога
ErrDescr Err.Number, Err.Description, "FrModGlobalProcedures.SelectCbx Комбобокс " & Cbx.Name & " Текст " & Txt
End Sub
Пользуйтесь на здоровье!
:)
Да, забыл. Для корректности нужно LCase делать, чтобы прописные и строчные буквы не различались
Что-то я попробовал - не хочет работать %(
Что-то я попробовал - не хочет работать %(
У меня последняя самая версия без проблем заработала. А что сообщает? Какая процедура сбоит?
Блин, забыл указать, что ErrDescr - это экземпляр из моей собственной библиотеки - он пишет лог ошибок в текстовый файл, чтобы работа пользователя не прерывалась, а я мог потом ошибки спокойно анализироать.
У меня последняя самая версия без проблем заработала. А что сообщает? Какая процедура сбоит?
Блин, забыл указать, что ErrDescr - это экземпляр из моей собственной библиотеки - он пишет лог ошибок в текстовый файл, чтобы работа пользователя не прерывалась, а я мог потом ошибки спокойно анализироать.
Может я чета не так подключил.... не знаю - времени не было разбираться... он просто ничего не делал.
Может я чета не так подключил.... не знаю - времени не было разбираться... он просто ничего не делал.
Нет, самая последняя версия точно работает - я её уже включил в код (см. самое последнее сообщение с кодом). Первые 3 процедуры - описание событий комбобокса CbCntHtl (из массива комбобокса). Последняя Public Sub SelectCbx(ByVal Cbx As Object, Txt As String, LisInd As Long, Optional Refr As Boolean) - и есть та процедура, которая перебирает комбобокс. Она получает на вход объект (комбобокс), букву клавиши, которую нажал пользователь, текущий листиндекс комбобокса (чтобы, если что, восстановить его) и, как необязательный параметр, флаг сброса всех свойств (чтобы не сохранялись данные о комбобоксе и тексте - ну в процедуре всё достаточно прозрачно). Обработчик ошибок тут совершенно не важен, хотя, если надо - вот код процедуры обработчика ошибок:
Public Sub ErrDescr(Optional ErrNumb As Long, Optional ErrDescript As String, Optional ProcName As String)
'МАХ процедура пишет в LOG-файл сообщения об ошибках _
получает код ошибки, описание, имя процедуры, вызвавшей ошибку
Dim LogFile As File 'МАХ файл лога
Dim FSO As New FileSystemObject 'МАХ ссылка на объект системной области файлов
Dim TxtStr As TextStream 'МАХ потолтк данных к/из файла(у)
Dim TextIn As String 'МАХ строка, которая будет писаться в лог-файл
Dim PathFile As String 'МАХ путь к файлу
On Error GoTo ErrHnd 'МАХ в случае ошибки переходим к собственному обработчику ошибок
Const NmeFil = "AnketaLog.log" 'МАХ имя лог-файла
'МАХ выводим сообщение об ошибке
MsgBox "Ошибка в модуле " & ProcName & vbCrLf & _
"Номер ошибки: " & ErrNumb & _
vbCrLf & "Описание:" & ErrDescript, vbCritical, "Ошибка в выполнении кода! Сообщите отделу IT!"
PathFile = App.Path & "\" & Trim(NmeFil) 'МАХ полный путь к файлу
'МАХ ищем файл
If FSO.FileExists(PathFile) = False Then 'МАХ если файла нет, то создадим его
FSO.CreateTextFile (PathFile)
Set LogFile = FSO.GetFile(PathFile) 'МАХ указываем файл
Set TxtStr = LogFile.OpenAsTextStream(ForWriting) 'МАХ открываем файл на запись
TxtStr.Write "Создан: " & Date & " " & Time & vbCrLf & _
"Начало======================================================================== " & _
vbCrLf & vbCrLf & vbCrLf
TxtStr.Close
End If
Set LogFile = FSO.GetFile(PathFile) 'МАХ указываем файл
Set TxtStr = LogFile.OpenAsTextStream(ForReading) 'МАХ открываем файл на запись
TextIn = TxtStr.ReadAll 'МАХ получаем содержимое файла
'МАХ закрываем файл
TxtStr.Close
Set TxtStr = LogFile.OpenAsTextStream(ForWriting) 'МАХ открываем файл на запись
'МАХ отслеживаем полученные переменные
If IsNull(ErrNumb) Then ErrNumb = 0
If IsNull(ErrDescript) Then ErrDescript = " "
If IsNull(ProcName) Then ProcName = " "
'МАХ формируем строку записи
TextIn = TextIn & _
"Ошибка № " & Trim(Str(ErrNumb)) & ";" & vbCrLf & "Описание: " & _
ErrDescript & ";" & vbCrLf & _
"Процедура: " & ProcName & vbCrLf & _
"Дата: " & Date$ & " " & Time$ & vbCrLf & _
"_______________________________________________________________________________" & _
vbCrLf & vbCrLf
'МАХ пишем текст в файл
TxtStr.Write TextIn
'МАХ закрываем файл
TxtStr.Close
Exit Sub 'МАХ конец процедуры в случае нормальной её работы
ErrHnd: 'МАХ область внутреннего обработчика ошибок
MsgBox "Внимание!" & vbCrLf & _
"Произошла ошибка в модуле обработчика сбоев!" & vbCrLf & _
"Срочно сообщите о ней сотрудникам IT отдела" & vbCrLf & _
"с описание того, в какой момент и " & vbCrLf & _
"при каких действиях она возникла!", vbCritical, _
"КРИТИЧНАЯ ОШИБКА В РАБОТЕ ПРОРАММЫ!!!!"
Resume Next 'МАХ предпринимаем попытку продолжить выполнение прцедуры
End Sub
Пользуйтесь!
P.S. Для работы обработчика нужно подключить библиотеку Microsoft Scripting Runtime (scrrun.dll)
Времени проверять столь длинный код нет, но пасиба, возьму на заметку %)
Кстати, народ, я тут прикол заметил. В последнее время я тут задаю вопросы, и сам же себе на них отвечаю :D . Это, конечно, нечто :D :D :D
А по поводу кода - он 100% рабочий. Я его как раз юзаю сейчас. Так что после небольших модификация под себя его любой сможет использовать.:)