Создание списка ListBox с переменной шириной столбцов средствами Microsoft Access.
Access является очень удачным инструментом, но как любое средство разработки не лишен ряда недостатков. Главный из них - скудость набора компонентов. Несмотря на то, что в основном они удовлетворяют интерфейсные потребности приложений СУБД, но время на месте не стоит, пользователь избалован богатством лакокрасочных покрытий в интерфейсах новых программ и систем. Даже апологеты серых форм в Microsoft сдались и выпустили "Luna" (это в Windows XP интерфейс так называется...). А вот в Access уже в очередной XP (или 2002) версии никакого интерфейсного прогресса не наблюдается. И выглядит такое Access-приложение посреди крикливого интерфейса Luna, как наша серая советская действительность, или как большая рваная дыра (даю возможность выбрать сравнение по вкусу). В общем, если Microsoft не идет к программеру, программер ... да не идет он к Microsoft, чего туда ходить, чего он там не видел... В магазин он идет, Кока-колу покупать. Потом садится, дудлит воду и думает, как жить дальше. О том, что убожество компонентов Access в скором времени станет мешать дышать, я предвидел, поэтому прорабатывал различные варианты. Один из них - переход на чистый, классический Visual Basic, при всех преимуществах имеет большой недостаток - порядочный размер готовой программы, которую в Большую сеть засунуть еще кое-как можно, а вот простым пользователям с трещащими как сорока каналами выкачать это добро сложновато. Они ведь своими кровными за закачку расплачиваются, да и нервная система у русского человека изрядно проржавела. Отпадает пока этот вариант. Но привлекателен он все же одной вещью - использованием компонентов фирмы Apex, называются они Apex True DBList (спискок и выпадающий список) и Apex True DBGrid (таблица или grid в английском просторечье). Компоненты просто роскошные, и красить их можно и по строкам и каждую ячейку в отдельности, все о чем только можно мечтать там есть, будьте спокойны. Забрать их можно отсюда - http://www.componentone.com/, я сам несколько дней потратил, пока нашел. Но вот беда с Access корректно не работают (Access просто рушится через какое-то время), несмотря на все заявления Microsoft о полной поддержке ActiveX в Access. Да и сами компоненты весят 4-5 МБ, их надо загружать, а еще возможные проблемы с регистрацией компонентов на машинах пользователей. Если бы не эти проблемы, купил бы я эти компоненты, несмотря на достаточно кусючую цену. Но что поделать, отложим до лучших времен. Другие компоненты имеют достаточно ограниченный набор возможностей, да и надежность их оставляет желать лучшего. Не могу я доверить свое приложение этим компонентам, пользователи ведь в меня кидать камни начнут, и все мои жалкие тыкания пальцем на настоящего виновника проблемы утонут в гуле возмущения. Спасение утопающих - дело рук самих утопающих. Начинаем спасаться.
Произведем инвентаризацию имеющегося арсенала.
1. Мы умеем отслеживать положение указателя мыши во время перемещения по объекту формы. Объекты могут быть разными. Это может быть голая поверхность самой формы. Может быть поле, надпись, кнопка, и т.д.
2. Мы знаем такое свойство списка как ColumnWidths. Задается с помощью строки, которая содержит ширины столбцов, разделенные точкой с запятой в единицах твип. Присваивая новые значения этому свойству списка можно изменять ширину столбцов.
3. Еще у нас есть такой интересный объект - Screen. Интересен он тем, что позволяет менять изображение курсора мыши. Одно из изображений - изменение размера по горизонтали. А вот это для нас настоящая удача.
Начнем с простого. Имеем список на основе стандартного запроса, использующего связку нескольких таблиц.
Вот он, наш запрос. А вот и наш список.
Идея заключается в следующем. Когда мы проводим курсором мыши в области заголовков столбцов, курсор будет изменять свой вид на "изменение размера по горизонтали" в тех местах, где проходят границы столбцов списка. Если в это время мы нажимаем левую кнопку мыши, то граница будет двигаться за курсором, влево или вправо, в итоге мы увидим стандартное изменение ширины столбцов. Так же, как, например, в Проводнике Windows.
На первом этапе попробуем менять курсор мыши на границе столбцов. Главная проблема на этом этапе в том, что ширина столбцов списка задается с помощью свойства ColumnWidths в виде строки, где значения разделены точкой с запятой, причем последнее значение точкой с запятой не отделяется. Например, если у списка свойство ColumnWidths возвращает значение "1200;2000;320", то это говорит нам о том, что у списка 3 столбца и ширина у них равна 1200 твип для первого, 2000 и 320 твип для второго и третьего соответственно. Поскольку хотим мы того или нет, но нам придется иметь дело с числовыми ширинами столбцов. Очевидно, что нам понадобится функция, которая преобразует строку ColumnWidths в набор числовых значений. В нашем примере имеется 4 столбца, следовательно размерность массива значений будет равна 4. Массив будет единым для всего модуля класса данной формы, поэтому описываем его в области общих параметров, в самом верху модуля "Dim dx(4) As Long". Назовем нашу функцию dx_former. Сама функция будет иметь вид :
Function dx_former(i_s As String) As Boolean 'запоминает строковую ширину столбцов в массиве dx Dim i As Long Dim xl As Long Dim xr As Long 'обнуляем массив ширины столбцов For i = 1 To 4 dx(i) = 0 Next i i_s = i_s & ";" 'поскольку нет последней точки с запятой, то проще всего ее самим добавить For i = 1 To 4 'ищем точку с запятой If i = 1 Then xl = 1 'xl содержит стартовую позицию, с которой ищем точку с запятой Else xl = xr + 1 'ищем точку с запятой со следующей позиции End If xr = InStr(xl, i_s, ";") 'xr-содержит позицию с точкой с запятой в зоне поиска dx(i) = Val(Trim(Mid(i_s, xl, xr - 1))) 'запоминаем ширину столбца в числовом виде Next i
End Function
Функция особо сложных решений не содержит. Ищем точки с запятыми, все что между ними - это и есть значения. Проблема была с последним значением, после которого точка с запятой не стоит. Пришлось выискивать хвост строки после точки с запятой и находить в нем значение. Но уже когда статью писал, пришла в голову мысль, простая как двери. Если точки с запятой в конце нет, то почему бы ее туда самим не добавить. Добавили, и все стало совсем красиво.
Изменять мы будем значения столбцов сначала в массиве dx, а затем формировать текстовую строку из этих значений для запоминания в свойстве ColumnWidths нашего списка. Нужна функция обратная от функции dx_former. Назовем ее c_w_former, то есть формирователь ColumnWidths. Функция достаточно простая и тянет на упражнение при изучении работы со строками. Вот ее текст:
Function c_w_former() As String 'формируем строку для ColumnWidths списка Dim i_s As String Dim i As Long i_s = "" 'временная рабочая строка For i = 1 To 4 'вытаскиваем из массива значения и набиваем в строку i_s = i_s & dx(i) & ";" Next i 'если справа появилась запятая, усекаем If Right(i_s, 1) = ";" Then i_s = Left(i_s, Len(i_s) - 1) c_w_former = i_s End Function
Когда мы двигаем курсор мыши, то мы должны отследить, попадаем ли мы курсором на границу между двумя столбцами. Во время перемещения курсора над списком, для нашего списка возникает событие "перемещение указателя" и можно вызвать процедуру обработки события. В эту процедуру передаются координаты курсора внутри списка и состояние кнопок мыши, то есть нажаты они в данный момент или нет. Вся проблема на данном этапе заключается в том, что у нас есть значения ширины столбцов, но нет координат границ этих столбцов. Довольно нетрудно выполнить преобразование этих значений. Для этого создаем функцию, которая на основе данных о ширинах столбцов вернет нам координаты правой границы заданного столбца. Назовем ее dx_pos.
Function dx_pos(col_number As Long) As Long 'получаем правую границу столбца в твипах, 'относительно левого края списка 'col_number - номер нужного столбца Dim i As Long Dim new_pos As Long new_pos = 0 For i = 1 To 4 new_pos = new_pos + dx(i) 'накапливаем позицию столбцов If i = col_number Then dx_pos = new_pos 'если нужный столбец, запоминаем Next i
End Function
Функция работает на основе данных из массива dx, в качестве параметра указываем номер требуемого столбца. Теперь, зная правую границу каждого столбца, нужно проверить, попадает ли в пределы этой границы курсор мыши. Дело в том, что твип-величина очень маленькая, а руки у нас как известно иногда дрожат. Тут без допусков и посадок не обойтись. Опыт показывает, что допуск в + - 30 твип относительно границы столбца оптимальный для этих целей. Впрочем это дело вкуса, можете менять. Это первая проблема. Вторая проблема, вытекающая кстати из первой, заключается в том, что нажав на кнопку мыши для изменения границы, наш курсор не находится точно на этой границе, а в пределах допуска. В момент нажатия надо запомнить разницу между координатами курсора мыши и границей столбца, после чего в течении всего времени перемещения курсора эту разность учитывать. Для этого создаем переменную razn, которая будет хранить значение нашей погрешности. Для того, чтобы мы всегда знали для какого столбца производится перемещение, нужно иметь переменную которая хранит номер изменяемого столбца. Если никакой столбец не меняем, переменную задаем нулевой. Таким образом убиваем двух зайцев. С одной стороны знаем - находимся ли в режиме изменения ширины, а с другой - ширины какого столбца конкретно. Назовем ее sh_but, она кстати тоже должна быть общей для всего модуля. Дело в том, что событие "перемещение указателя возникает столько раз, сколько раз курсор мыши изменяет свои координаты. Пока мы перемещаем курсор, событие возникает непрерывно, получается своего рода цикл, и нам нужно в начале следующего витка помнить, ширину какого столбца мы меняем. Обнулять данную переменную нужно в двух случаях.
1. Если мы отпускаем кнопку
2. Если курсор покинул пределы списка.
В результате наша процедура обработки перемещения указателя выглядит так.
Private Sub ree_list_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Dim i As Long Dim per As Boolean per = False 'переключатель изображения курсора, false-нормальный
For i = 1 To 4 'перебираем столбцы If ((dx_pos(i) - 30) < X) And ((dx_pos(i) + 30) > X) Then 'если попали в зону If ((Button And acLeftButton) > 0) And (sh_but = 0) Then ' и нажата кнопка (а до этого не была нажата) sh_but = i 'запоминаем столбец razn = X - (dx_pos(i)) 'запоминаем разницу между границей и позицией курсора 'в момент нажатия End If per = True 'меняем курсор на "<->" GoTo ex 'вываливаемся из списка End If Next i
'код изменения ширины столбца If sh_but > 0 Then 'если кнопка нажата If X - razn > dx_pos(sh_but - 1) Then 'и при движении влево не налезем на соседний столбец dx(sh_but) = X - razn - dx_pos(sh_but - 1) 'меняем ширину столбца на новую Me!ree_list.ColumnWidths = c_w_former 'прописываем новую ширину столбцов в списке End If End If
ex: If per = True Then Screen.MousePointer = 9 Else Screen.MousePointer = 0
End Sub
Почему функция разбита на 2 куска. Казалось бы, нет ничего проще вставить код изменения ширины столбца прямо в цикл. Нарвались на нужный столбец и меняем его ширину. Я так сразу и сделал, а включил и не заработало. А почему? Потому, что зафиксировать переменную razn нам нужно только один раз в момент нажатия на кнопку мыши. Значит должна отработать некоторая триггерная защелка. Именно внутри цикла она и отрабатывает, а роль триггерной защелки выполняет наша любимая переменная sh_but. До нажатия на кнопку мыши она нулевая. Как только в зоне какого-то столбца мы нажимаем на кнопку, отрабатывает условие и мы фиксируем переменную razn и запоминаем столбец в переменной sh_but. Больше мы внутрь этого условия не попадем, пока не отпустим кнопку. Зато вторая часть процедуры отслеживает работу именно в режиме нажатой кнопки и изменяет ширину столбца согласно нашим неуверенным движениям мышью. Как только мы кнопку мыши отпустили, sh_but становится нулевой, и функция снова готова поймать нас внутрь условия, если мы нажмем кнопку в зоне изменения размера. За отпускание кнопки отвечает процедура обработки события "кнопка вверх".
Private Sub ree_list_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) sh_but = 0 ' при отпускании кнопки сбрасываем перемещение столбцов End Sub
Вот собственно и все. Архив с рабочим примером вы можете найти на сайте моей конторы Megakot Software http://www.megakot.com/
Коментарии (2)