ListBox ActiveX с уникальными значениями

@giaber · Регистрация: 16.09.2014

Студворк — интернет-сервис помощи студентам

Нужен контрол ListBox, который будет
1) при AddItem проверять, нет ли уже в ListBox такого значения и добавлять только в том случае, если вводимое является уникальным
2) дополнительно к Sorted, нужно свойство SortRevers, то есть сортировка в обратном порядке. То есть нужно чтоб сортировка вообще включалась/отключалась (Sorted=True/False) и если сортировка включена, чтоб сортировало так, как диктует SortRevers=True/False (обратная/прямая сортировка).

Проблема собсно, в чём - написать несколько строк проверки уникальности я могу сам, но никак не могу понять куда мне её вписывать, прочёл кучу всяких текстов по созданию контролов, Эскина того же, но, что поделаешь - тупой видимо, никак не могу создать листбокс! Отсюда две просьбы:

1)Не может ли кто-нибудь сделать так сказать "шаблон" пользовательского ListBox контрола из обычного ListBox и указать внутри где мне вставить проверку уникальности. Вроде это для знающего человека совсем несложно. Типа :

Visual Basic
1
2
3
Private Sub CheckUnique()
"Здесь, дебилоид, должен быть твой код! Смотри не напутай!"
End Sub

2)Можете ли посоветовать как реализовать обратную сортировку - то есть не сам код прошу (обратную сортировку и перемещение элементов списка я знаю как сделать), а подходы какие могут быть, не совсем представляю логику работы обратной сортировки (особенно в связи со свойством Sorted=True/False), когда она должна происходить? Свойство Sorted должно быть видимо False?
То есть я как представляю, если я хочу сделать обратную сортировку, сперва должно устанавливаться Sorted=True (отсортировалось нормально), затем Sorted=False и только после этого я манипулирую с элементами списка для сортировки в обратном порядке, да? или бред?

Заранее благодарен!

Dragokas · 22.08.2015, 21:04

Если у ListBox-а установлен стиль LBS_SORT, расположение добавляемых через сообщение LB_ADDSTRING строк определяется с помощью другого сообщения - WM_COMPAREITEM.

Поскольку у этого контрола из-за его специфики работы стиль LBS_SORT является ReadOnly,
Вы можете либо создать поверх еще один контрол ListBox с .Soretd = true, управляя видимостью или очередностью окон.
Либо реализовать это своим алгоритмом сортировки, таким образом прочитав все элементы ListBox-a в массив.

На счет проверки, уникален ли элемент, можно воспользоваться сообщением

C++
1
iIndex = SendMessage (hwndList, LB_SELECTSTRING, iIndex, (LPARAM) szSearchString);

где iIndex - индекс, начиная с которого вести поиск, а szSearchString - искомая фраза.

Добавлено через 3 минуты
Если контрол делать свой, то можно и завести себе локально словарь (Scripting.Dictionary), куда параллельно с ListBox-ом заносить добавляемые значения. Таким образом значительно ускорите проверку на уникальность.

@giaber · 23.08.2015, 02:45 **[ТС]**

Поскольку, прочитав кучу руководств по созданию ActiveX-контролов (29, Карл! 29!) я так ни черта и не понял (гордо несу знамя заслуженного ламера!), буду пытаться получить ответы здесь. Надеюсь, кто-нибудь поможет.
Непонятного много, поэтому буду спрашивать порциями.

Попытаюсь сформулировать, что мне нужно от листбокса (назовём его допустим UVList – то есть, Unical Value List):
1) Unical As Boolean – если True, то при AddItem новый элемент добавляется только если в списке нет такого же, если False – листбокс работает как стандартный, если в теле проги поступает команда UVList1.Unical=True, то если UVList1 непустой, все дупликаты должны удалиться.

Создал User контрол UVList с List1 внутри

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'Default Property Values:
Const m_def_List = ""
Const m_def_ListCount = 0
Const m_def_ListIndex = 0
Const m_def_Unical = 0
Const m_def_Sort = 0
Const m_def_SortAscDsc = 0
'Property Variables:
Dim m_List As String
Dim m_ListCount As Integer
Dim m_ListIndex As Integer
Dim m_Unical As Boolean
Dim m_Sort As Boolean
Dim m_SortAscDsc As Boolean
Private Declare Function SendMessageByString Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

и прописал в AddItem такое:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Function SendMessageByString Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
 
Public Sub AddItem(ByVal Item As String, Optional ByVal Index As Variant)
    List1.AddItem (Item)
    Call DelDups
End Sub
 
Public Sub DelDups()
    For X = 0 To List1.ListCount - 1
        For Y = 0 To List1.ListCount - 1
            ListPos = SendMessageByString(List1.hWnd, &H1A2, 0, List1.List(X))
            If ListPos <> X And ListPos <> -1 Then List1.RemoveItem ListPos
        Next Y
    Next X    
End Sub

Вроде работает и в контроле только уникальные значения, но мне ведь надо чтоб зависело от Unical (True/ False). То есть по ламерской моей логике должно быть что-то вроде:

Visual Basic
1
2
3
4
5
Public Sub DelDups()
If List1.Unical = False Then Exit Sub (или UVList.Unical = False)
…
…
End Sub

Но такое VB не кушает:

Visual Basic
1
2
List1.Unical = False - “Method or data member not found”
UVList.Unical = False - “Object required”

Понимаю, что какой-то бред ламерский, подскажите как правильно
'----------------
Dragokas, спасибо конечно, за помощь, но я очень ламер и для меня это как-то сложно очень, это не мой уровень к сожалению...

@The trick · 23.08.2015, 08:31

https://www.cyberforum.ru/post7049019.html
Вот пример необычного листбокса. Можешь модифицировать его как нужно.

@giaber · 23.08.2015, 17:57 **[ТС]**

TheTrick, спасибо вам за контрол, правда почти ничего не понятно, но надеюсь на вашу помощь (с переводом в монохромный рисунок вы мне ОЧЕНЬ помогли и просветили, пользуюсь моментом ещё раз поблагодарить!)
Во-первых никак не смог вычленить из кода всё, что относится к этой нестандартной функции ротации строк листбокса, хочется иметь «чистый» контрол. Не могу понять роль GRANULARITY. Ну, да это ладно, главное, что не понимаю: что надо сделать, чтоб у контрола вообще появились свойства Unical,Sort и SortAscDsc (см. ниже), что надо сделать, чтоб эти свойства были Read/Write в обоих режимах - и Runtime и Designtime. Короче, ни бум-бум… Сортировки, удаление дупликатов – это не проблема, работу с массивами на таком уровне я знаю, проблема в том, что я совершенно не понимаю механизмов, структуры и синтаксиса этого всего дела (29 прочитанных источников мне не помогли, к сожалению)…
Я всё же наберусь наглости и попрошу вас - не могли бы вы наваять (простите за фамильярность!) такой же контрол, как вы выложили, но без наворотов, простенький, и сделать структуру, а сами сортировки и удаление дупликатов я бы сам вставил. Да и на примере сделанного вами я бы уже смог понять, как мне в дальнейшем создавать такие контролы с другими, нужными мне свойствами. Контрол используется чисто как контейнер для сортировки и бездупликативности, ему даже скролы не нужны, да и вообще почти ничего, в основном он в режиме Visible=False работает, ну иногда только при отладке проги нужно посмотреть, правильно ли данные в него закачаны.

1) Unical As Boolean – если True, то при AddItem новый элемент добавляется только если в списке нет такого же, если False – листбокс работает как стандартный, если в теле проги поступает команда UVList1.Unical=True, то если UVList1 непустой, все дупликаты должны удалиться.
2) Sort (As Boolean) – если Sort =True, то при AddItem список сортируется, если False – листбокс работает как стандартный, если в теле проги поступает команда UVList1.Sort =True, то если UVList1 непустой, список должен отсортироваться.
3) SortAscDsc (As Boolean) – указывает направление сортировки, SortAscDsc =True - в возрастающем порядке, SortAscDsc = False - в убывающем, если в теле проги поступает команда UVList1. SortAscDsc =True/False , то если UVList1 непустой, список должен отсортироваться соответственно True/False.
Со структурой вроде бы несложно и всё ясно:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Public Sub AddItem()
 
    UVList.AddItem 'добавляем в любом случае
    If UVList.Unical = True Then Call DelDups ' удаление дупликатов
    
    If UVList.Sort = True Then
        If UVList.SortAscDsc = True Then Call SortAsc 'сортировка в возрастающем порядке
    Else
        Call SortDsc 'сортировка в убывающем порядке
    End If
 
End Sub

@The trick · 23.08.2015, 19:41

В данный момент не имею компьютера, может позже помогут.

Добавлено через 2 минуты
Кстати я как-то здесь выкладывал код сканирования реестра, так вот там использовалась наипростейшая хеш-таблица и дубликаты автоматически отвергались.

Добавлено через 11 минут
https://www.cyberforum.ru/post6179213.html

@giaber · 24.08.2015, 15:08 **[ТС]**

С помощью пендюлей от DIS (с форума на Исходниках) и уважаемого TheTrik наваял уродливый (советы-то были отличные, это я сам всё изуродовал), но работающий (вроде) контрол, кто сможет-протестируйте на ошибки и, конечно, критикуйте безжалостно:

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

@The trick Модератор 10048 / 3894 / 883 Регистрация: 22.02.2013 Сообщений: 5,847 Записей в блоге: 79
	23.08.2015, 08:31
	https://www.cyberforum.ru/post7049019.html Вот пример необычного листбокса. Можешь модифицировать его как нужно. 2

@The trick Модератор 10048 / 3894 / 883 Регистрация: 22.02.2013 Сообщений: 5,847 Записей в блоге: 79
	23.08.2015, 19:41
	В данный момент не имею компьютера, может позже помогут. Добавлено через 2 минуты Кстати я как-то здесь выкладывал код сканирования реестра, так вот там использовалась наипростейшая хеш-таблица и дубликаты автоматически отвергались. Добавлено через 11 минут https://www.cyberforum.ru/post6179213.html 1