| Вопрос: VB - ListBox - Исключение дубликатов | Добавлено: 02.03.05 20:09 |
Автор вопроса:  ZagZag | ICQ: 295002202 |
|
Может кто сталкивался с проблемой исключения дубликатов в ListBox?
- Исключить все повторяющиеся значения в ListBox - Данные в ListBox не упорядочены. - Без учета регистра символов. - В списке от 1 до Long записей - ListBox - виртуальный hWnd = CreateWindowEx(0, "ListBox", "Virtual ListBox",
LBS_NOREDRAW Or WS_CHILD, 0, 0, 0, 0, frmMain.hWnd, 0, App.hInstance, ByVal 0) Есть варианты: 1) Все-таки упроядочить список (QSortListBox) и исключать по порядку все дубликаты, оставляя естественно по одному уникальному. (Довольно эффективно для <100000 строк, но оч. хорошо ЖРЕТ память) 2) Создание еще одного LB Полный цикл по главному списку Использовать LB_FINDSTRING по новому списку, если не найдено, то добавить в новый список. Очистать главный список и скопировать в него данные из нового Удалить временный список (Способ очень медленный, но памяти занимает мало) Помогите найти компромисс или подскажите наиболее эффективный способ PS Не возражаю если какой вариант будет в Библиотеку кодов добавлен (вышлю сырцы как попросите) :) |
| Ответы | Всего ответов: 23 |
|
Номер ответа: 1 Автор ответа:  cresta Вопросов: 117 Ответов: 1538 |
Профиль | | #1 | Добавлено: 02.03.05 22:14 |
|
Есть такой вариант:
Dim i As Long, k As Long, s As String, a
For i = 0 To List1.ListCount - 1 If InStr(1, s, List1.List(i)) = 0 Then s = s & "###" & List1.List(i) k = k + 1 End If Next i Debug.Print k a = Split(s, "###" 
List1.Clear For i = 0 To UBound 
List1.AddItem a(i) Next i Debug.Print List1.ListCount А как ты в листбокс засовываешь 100000 элементов и более ??? |
||
|
Номер ответа: 2 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #2 | Добавлено: 03.03.05 05:08 |
|
Виртуальный ЛистБокс
Создаю CreateWindowEx Работаю через SendMessage Удаляю DestroyWindow Твой вариант со сплитом, ИМХО, не оптимальный 
|
||
|
Номер ответа: 3 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #3 | Добавлено: 03.03.05 07:55 |
|
Перерыл весь msdn, никакого виртуального листбокса не нашёл, листвью - есть, а листбокс...
Даже имя класса "Virtual ListBox" вообще не встречается. Ты где такое нашёл  Или это какой самодельный контрол?
|
||
|
Номер ответа: 4 Автор ответа: SharpЛидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #4 | Добавлено: 03.03.05 08:21 |
| Что-то мне подсказывает, что имя класса здесь ListBox, а "Virtual ListBox" - это имя окна | ||
|
Номер ответа: 5 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #5 | Добавлено: 03.03.05 09:09 |
| Я имею ввиду искал по словам Virtual ListBox в надежде найти что-нибудь об этом чуде. | ||
|
Номер ответа: 6 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #6 | Добавлено: 04.03.05 05:47 |
|
Хе! А есть разница?
"ListBox" - имя класса (Class Name, которое предопределено) "Virtual ListBox" - имя окна (Window Name, которое можно указывать любым) Да вы что незнали о таком? Я же эту идею из API ListBox взял. Вы его исходники хоть смотрели?! Но вопрос-то не в том как с ним работать, а как исключить дубликаты. LB_REMOVEITEM занимает много памяти, т. к. все строки ниже удаляемой перестраиваются - его использовать только для маленьких объемов упорядоченных строк (<32767 строк) Пожалуйста, делитесь ЛЮБЫМИ идеями ПО ДАННОЙ ТЕМЕ
|
||
|
Номер ответа: 7 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #7 | Добавлено: 04.03.05 07:53 |
|
Что-то не нашёл исходников этого чуда.
А можно было бы посмотреть и попробовать пооптимизировать с удалением. |
||
|
Номер ответа: 8 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #8 | Добавлено: 04.03.05 08:06 |
|
По первому варианту: сортировка нарушает исходный порядок. Это не является минусом?
И как быстро сортируется и удаляется? Например для случая многократного повторения элементов. Или для случая, когда повторений мало. Например, для 30000 элементов. |
||
|
Номер ответа: 9 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #9 | Добавлено: 04.03.05 08:09 |
|
завтра код выставлю или вечером сегодня
|
||
|
Номер ответа: 10 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #10 | Добавлено: 04.03.05 16:05 |
|
Эххх! От сердца отрываю! (жадный я)
Private Sub ExcludeCopies(ByVal hWnd As Long)
'Цель: Исключение дублирующихся значений в ListBox 'Автор: ZagZag (zagzag@xaker.ru) 'Создано: 04.03.2005 14:00 Dim lngIndex As Long Dim lngCount As Long Dim hListExcluded As Long Dim strCurrent As String Dim strNext As String lngCount = SendMessage(hWnd, LB_GETCOUNT, 0, 0) - 1 If lngCount = -1 Then Exit Sub SortListBox hWnd 'Создание временного виртуального ЛистБокса hListExcluded = CreateWindowEx(0, "ListBox", "Virtual ListBox", LBS_NOREDRAW Or WS_CHILD, 0, 0, 0, 0, frmMain.hWnd, 0, App.hInstance, ByVal 0) strCurrent = String$(SendMessage(hWnd, LB_GETTEXTLEN, 0, ByVal 0), vbNullChar) SendMessage hWnd, LB_GETTEXT, 0, ByVal strCurrent For lngIndex = 0 To lngCount strNext = String$(SendMessage(hWnd, LB_GETTEXTLEN, lngIndex, ByVal 0), vbNullChar) SendMessage hWnd, LB_GETTEXT, lngIndex, ByVal strNext If LCase(strNext) <> LCase(strCurrent) Then strCurrent = strNext SendMessage hListExcluded, LB_ADDSTRING, 0, ByVal strNext End If If (GetTickCount Mod 100) = 0 Then 'А как иначе? Иначе виснет. DoEvents End If Next SendMessage hListExcluded, LB_ADDSTRING, 0, ByVal strNext 'Очистить главный ЛискБокс SendMessage hWnd, LB_RESETCONTENT, 0, 0 'Копировать все из временного ЛистБокса в главный lngIndex = 0 lngCount = SendMessage(hListExcluded, LB_GETCOUNT, 0, 0) - 1 For lngIndex = 0 To lngCount strCurrent = String$(SendMessage(hListExcluded, LB_GETTEXTLEN, lngIndex, ByVal 0), vbNullChar) SendMessage hListExcluded, LB_GETTEXT, lngIndex, ByVal strCurrent SendMessage hWnd, LB_ADDSTRING, 0, ByVal strCurrent If (GetTickCount Mod 100) = 0 Then 'А как иначе? Иначе виснет. DoEvents End If Next 'Удаление временного ЛискБокса  estroyWindow hListExcluded
End Sub Это один из оптимальных способов реализованных лично мной Что здесь можно оптимизировать или может есть более быстрый способ для большИх (~1000000 строк) списков? Впрочем... может сразу массив строковых элементов обрабатывать? Тогда добавлять как если размер заранее неизвестен (ReDim не подходит - тормоза) Или может этот модуль на асм или PB перевести? Кстати, как в PB-DLL работать со списком по hWnd ЛистБокса - у меня hWnd библиотечка получает, но обрабатывать его никак не хочет. (PB понравился из-за его встроенной возможности ассемблерных вставок и независимости EXE от "Виртуальных машин"
|
||
|
Номер ответа: 11 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #11 | Добавлено: 04.03.05 17:34 |
|
А где виртуальный листбокс? Вижу только самый обычный и стандартный windows control listbox
Что представляет из себя процедура SortListBox? Как долго работает к примеру для 50000 элементов? И на какой машине? Например для listbox'a, заполненного таким кодом: Dim i As Long
For i = 0 To 50000 List1.AddItem Int(Rnd * (10000)) Next i |
||
|
Номер ответа: 12 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #12 | Добавлено: 04.03.05 17:43 |
| Тот способ, что я предлагал (со сплитом) для 50000 заполненных как указано выше, чистит список за 7 сек. Ему всё равно, сортирован или нет список. Твой в тепличных условиях (даю ему уже сортированный - иначе он просто не работает) 1 сек. Как быстро работает твоя SortListBox? | ||
|
Номер ответа: 13 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #13 | Добавлено: 05.03.05 07:45 |
|
Для 50000 тексктовых строк:
Я понял что код больше задерживается при добавлении строк из списка в массив и обратно (тормозят большие массиывы?) Тест производительности: - добавление в список = 3,2 сек. - сортировка = 11,62 сек. - исключение (+ сортировка) = 8,22 сек. Гы! Я фигею!
Формула: исключение = исключение (+ сортировка) - сортировка исключение = 8,22 сек.- 11,62 сек. отсюда исключение = -3,4 сек!!! (Довольно шустро... ) |
||
|
Номер ответа: 14 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #14 | Добавлено: 05.03.05 08:11 |
|
Чё-то я не понял:
сортировка = 11,62 сек исключение (+ сортировка) = 8,22 сек Это как??? Исключение получается отрицательное время??? Или исключение+сортировка=19,84 сек? Ты напиши, сколько занимает полностью удаление дубликатов. Имеем: заполненный несортированный лист. Запускаем секундомер. Через сколько времени все дубликаты будут удалены и лист заполнен снова, уже без дубликатов? Думаю, что со сплитом трудно будет состязаться |
||
|
Номер ответа: 15 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #15 | Добавлено: 05.03.05 10:35 |
|
А! Лажанулся мальца...
Время получилось отрицательным (в формуле), т. к. исключение дубликатов + сортировка применялись к уже отсортированному списку... Значит верным будет: (исключение применимо только к отсортированному списку, т. ч. исключение+сортировка) исключение(+сортировка) = 15,03 сек. (Пробовал не на списке из Rnd, а на предопределенном списке из 50 тыс. строк) Процедура сортировки: Модуль: basListQuickSort Автор: Какой-то Edmundo T. Mendiola Код я полностью перебрал... но так и не смог понять принцип алгоритма. Может и этот модуль можно как-нибудь оптимизировать... (см. комментарии, может быть оптимизировать как в них? хотя вряд ли) Option Explicit
Private StringArr() As String Public Sub SortListBox(ByVal hListBox As Long) Dim lngIndex As Long Dim lngCount As Long Dim strListString As String lngCount = SendMessage(hListBox, LB_GETCOUNT, 0, ByVal 0) ReDim StringArr(lngCount - 1) For lngIndex = 0 To lngCount - 1 strListString = String$(260, vbNullChar) 'String$(SendMessage(hListBox, LB_GETTEXTLEN, lngIndex, ByVal 0), vbNullChar) SendMessage hListBox, LB_GETTEXT, lngIndex, ByVal strListString StringArr(lngIndex) = Left$(strListString, InStr(strListString, vbNullChar) - 1) Next QuickSortStringArray LBound(StringArr), UBound(StringArr) SendMessage hListBox, LB_RESETCONTENT, 0, ByVal 0 lngCount = UBound(StringArr) For lngIndex = 0 To lngCount ' strListString = StringArr(lngIndex) SendMessage hListBox, LB_ADDSTRING, 0, ByVal StringArr(lngIndex) Next End Sub Public Sub QuickSortStringArray(ByVal lngLBound As Long, ByVal lngUBound As Long) Dim lngX As Long Dim lngY As Long Dim strMidBound As String Dim strTemp As String If lngUBound >= 0 Then If lngUBound > lngLBound Then strMidBound = LCase$(StringArr((lngLBound + lngUBound) \ 2)) lngX = lngLBound lngY = lngUBound Do While lngX <= lngY If LCase$(StringArr(lngX)) >= strMidBound And LCase$(StringArr(lngY)) <= strMidBound Then strTemp = StringArr(lngX) StringArr(lngX) = StringArr(lngY) StringArr(lngY) = strTemp lngX = lngX + 1 lngY = lngY - 1 Else If LCase$(StringArr(lngX)) < strMidBound Then lngX = lngX + 1 If LCase$(StringArr(lngY)) > strMidBound Then lngY = lngY - 1 End If Loop QuickSortStringArray lngLBound, lngY QuickSortStringArray lngX, lngUBound End If End If End Sub |
||