Я придумал следующий код, который скрывает все мрачные детали за классом. По сути, я реализовал идею Грега об использовании наложения другой полосы прокрутки поверх полосы прокрутки отключенного списка. В моем коде я динамически создаю другой элемент управления ListBox (с измененным размером, чтобы была видна только его полоса прокрутки), и использую его полосу прокрутки для прокрутки фактического ListBox. Я также специально избегал использования Windows API (за исключением вызова GetSystemMetrics, который использовался для определения ширины полосы прокрутки в системе). Хорошая вещь об использовании другой полосы прокрутки ListBox состоит в том, что она будет правильно тематизирована (ListBox использует тему ОС, когда отображает свою полосу прокрутки, а VB.Scrollbar - нет, поэтому она будет выглядеть неуместно). Другое преимущество использования второго ListBox для прокрутки первого списка состоит в том, что действительно легко реализовать логику прокрутки (просто установите свойство TopIndex первого ListBox равным свойству TopIndex второго ListBox при каждой прокрутке второго).
Я также настроил его так, чтобы он был настолько слабым, насколько это возможно (вам нужно вызвать только одну функцию в вашем Form_Load событии, чтобы она работала).
Использование
Добавьте CustomScrollingSupport.cls и ListBoxExtras.bas к вашему проекту.
В событие Form_Load вашей формы добавьте следующую строку:
AddCustomListBoxScrolling Me
Это заставит все VB.ListBox в форме поддерживать прокрутку, даже когда они отключены. Если вы хотите добавить эту функцию только к выбранному числу ListBox, вы можете вместо этого вызвать AddCustomScrollingSupport, передав определенный элемент управления ListBox.
Интересная заметка
В более старой версии этого кода я не вызывал метод ZOrder во втором списке (тот, который предоставляет полосу прокрутки), чтобы убедиться, что он будет отображаться поверх первого списка. Это означало, что второй список был фактически за первым списком; Интересно то, что прокрутка на втором ListBox все еще работала, когда первый ListBox был отключен! По-видимому, когда первый ListBox отключен, любые события мыши и клавиатуры, которые должны были пройти в этот ListBox, «просочились» во второй ListBox, поэтому поддержка прокрутки по-прежнему работает. Я не уверен, является ли это ошибкой или намерением (я имею в виду, вы могли бы утверждать, что имеет смысл, что элементы управления за отключенным элементом управления смогут получать события ...). Тем не менее, время от времени я обнаружил, что прокрутка немного прерывистая, поэтому я решил добавить .ZOrder 0, чтобы второй список отображался поверх первого. Это имеет тот недостаток, что вы видите рамку рамки для второго списка (слева от полосы прокрутки), которую вы не увидите, если она будет скрыта за первым списком, но прокрутка будет более плавной.
<Ч />
CustomScrollingSupport.cls
Этот класс объединяет логику, необходимую для добавления «пользовательской поддержки прокрутки» (из-за отсутствия лучшего имени) в элемент управления VB.ListBox. Его не следует использовать напрямую, вместо этого используйте один из методов Add* в модуле ListBoxExtras.bas (код этого модуля я предоставлю позже в этом посте).
Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXVSCROLL = 2
Private Const SM_CXFRAME = 32
Private m_runningScrollers As Collection
Private WithEvents m_list As VB.listbox
Private WithEvents m_listScroller As VB.listbox
'--------------------------------------------------------------'
' Bind '
' '
' Adds custom scrolling support to a ListBox control. '
' Specifically, it allows the ListBox to be '
' scrolled even when it is disabled. '
' '
' Parameters: '
' '
' + list '
' the ListBox control to add custom scrolling support to '
' '
' + runningScrollers '
' a Collection of CustomScrollingSupport objects. Passed '
' in so that this object can remove itself from the list '
' when it is terminated. '
' '
'--------------------------------------------------------------'
Public Sub Bind(ByVal list As VB.listbox, runningScrollers As Collection)
Set m_list = list
Set m_runningScrollers = runningScrollers
'Create another ListBox loaded with the same number of entries as the real listbox'
Set m_listScroller = m_list.Container.Controls.Add("VB.ListBox", list.Name & "_scroller")
LoadScrollerList
Dim nScrollbarWidth As Long
nScrollbarWidth = GetSystemMetricScaled(SM_CXVSCROLL, m_list) + _
GetSystemMetricScaled(SM_CXFRAME, m_list)
'Display the other listbox (the "scroller"), just wide enough so that only its scrollbar is visible'
'and place it over the real listboxs scroll bar'
With m_listScroller
.Left = m_list.Left + m_list.Width - nScrollbarWidth
.Top = m_list.Top
.Height = m_list.Height
.Width = nScrollbarWidth
.Enabled = True
.Visible = True
.ZOrder 0
End With
End Sub
Private Sub m_listScroller_Scroll()
'If the master list has changed, need to reload scrollers list'
'(not ideal, but there is no ItemAdded event that we could use to keep the lists in sync)'
If m_list.ListCount <> m_listScroller.ListCount Then
LoadScrollerList
End If
'Make any scrolling done on the scroller listbox occur in the real listbox'
m_list.TopIndex = m_listScroller.TopIndex
End Sub
Private Sub Class_Terminate()
Dim scroller As CustomScrollingSupport
Dim nCurrIndex As Long
If m_runningScrollers Is Nothing Then
Exit Sub
End If
'Remove ourselves from the list of running scrollers'
For Each scroller In m_runningScrollers
nCurrIndex = nCurrIndex + 1
If scroller Is Me Then
m_runningScrollers.Remove nCurrIndex
Debug.Print m_runningScrollers.Count & " scrollers are running"
Exit Sub
End If
Next
End Sub
Private Sub LoadScrollerList()
Dim i As Long
m_listScroller.Clear
For i = 1 To m_list.ListCount
m_listScroller.AddItem ""
Next
End Sub
Private Function GetSystemMetricScaled(ByVal nIndex As Long, ByVal ctrl As Control)
GetSystemMetricScaled = ctrl.Container.ScaleX(GetSystemMetrics(nIndex), vbPixels, ctrl.Container.ScaleMode)
End Function
<Ч />
ListBoxExtras.bas
Этот модуль содержит два служебных метода:
AddCustomScrollingSupport добавляет пользовательские функции прокрутки
частному лицу VB.ListBox
контроль
AddCustomListBoxScrolling добавляет пользовательскую прокрутку
функциональность для каждого VB.ListBox
контроль над данным Form
Option Explicit
Public Sub AddCustomScrollingSupport(ByVal list As VB.listbox)
Static runningScrollers As New Collection
Dim newScroller As CustomScrollingSupport
Set newScroller = New CustomScrollingSupport
runningScrollers.Add newScroller
newScroller.Bind list, runningScrollers
End Sub
Public Sub AddCustomListBoxScrolling(ByVal frm As Form)
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is VB.listbox Then
AddCustomScrollingSupport ctrl
End If
Next
End Sub