|
Die Maus-Ereignisse einer ListBox sind ja gut und schön. Leider liefern sie jedoch weder Informationen darüber, ob sich ein ListItem unter dem Mauszeiger befindet, noch darüber, welches ListItem dies gegebenenfalls sein könnte. Wenn Sie beispielsweise ein Kontextmenü zu einem ausgewählten ListItem anzeigen möchten, kommen Sie jedoch nicht umhin, sich die entsprechende Information mit Hilfe des Windows-API zu beschaffen. Ein Aufruf der Funktion  SendMessage mit der spezifischen ListBox-Nachricht LB_ITEMFROMPOINT und der Angabe der Maus-Koordinaten liefert den Index des ListItems unter dem Mauszeiger.
Abgesehen von der notwendigen Umrechnung der in den Mausereignissen einer ListBox in Twips gelieferten Mauskoordinaten (X und Y) ist das kein großer Aufwand. Sie können ihn bequem in eine Hilfsfunktion verpacken:
Function GetIndex(ListBox As ListBox, ByVal X As Single, _
ByVal Y As Single) As Long
Dim nXPoint As Long
Dim nYPoint As Long
Dim nPoint As Long
Dim nIndex As Long
With ListBox.Parent
nXPoint = .ScaleX(X, vbTwips, vbPixels)
nYPoint = .ScaleY(Y, vbTwips, vbPixels)
nPoint = nYPoint * 65536 + nXPoint
End With
With ListBox
nIndex = SendMessage(.hWnd, LB_ITEMFROMPOINT, 0, nPoint)
Select Case nIndex
Case 0 To .ListCount - 1
GetIndex = nIndex
Case Else
GetIndex = -1
End Select
End With
End Function
Etwas mehr Spaß macht es allerdings, die Funktionalität in ein Partner-Steuerelement zu verpacken, das mit einer ListBox verbunden wird und Ereignisse anbietet, mit denen gleich der Index des ListItems unter dem Mauszeiger übergeben wird. Das hier vorgestellte Steuerelement ListItemEvents baut dazu auf der unter  Steuerelemente auf Brautschau im Detail beschriebenen Technik und der Darstellung zur Entwicklungszeit auf.
Die Deklaration der zur Ermittlung des eines ListItems unter dem Mauszeiger benötigten API-Funktion SendMessage lautet:
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Die von diesem Steuerelement zur Verfügung gestellten Ereignisse werden wie folgt deklariert und verarbeitet:
Public Event MouseDown(ItemIndex As Long, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(ItemIndex As Long, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(ItemIndex As Long, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Private Sub eListBox_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If pEnabled Then
RaiseEvent MouseDown(zGetIndex(X, Y, vbTwips), Button, _
Shift, X, Y)
End If
End Sub
Private Sub eListBox_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If pEnabled Then
RaiseEvent MouseMove(zGetIndex(X, Y, vbTwips), Button, _
Shift, X, Y)
End If
End Sub
Private Sub eListBox_MouseUp(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If pEnabled Then
RaiseEvent MouseUp(zGetIndex(X, Y, vbTwips), Button, _
Shift, X, Y)
End If
End Sub
Der Index des ListItems unter dem Mauszeiger wird mit einer wie bereits oben beschriebenen Hilfsfunktion ermittelt:
Private Function zGetIndex(ByVal iX As Single, _
ByVal iY As Single, ByVal iScaleMode As Integer) As Long
Dim nXPoint As Long
Dim nYPoint As Long
Dim nPoint As Long
Dim nIndex As Long
Const LB_ITEMFROMPOINT = &H1A9
With UserControl
nXPoint = .ScaleX(iX, iScaleMode, vbPixels)
nYPoint = .ScaleY(iY, iScaleMode, vbPixels)
nPoint = nYPoint * 65536 + nXPoint
End With
With eListBox
nIndex = SendMessage(.hWnd, LB_ITEMFROMPOINT, 0, nPoint)
Select Case nIndex
Case 0 To .ListCount - 1
zGetIndex = nIndex
Case Else
zGetIndex = -1
End Select
End With
End Function
Hier kann zusätzlich noch die Maßeinheit im Parameter ScaleMode übergeben werden. Damit lässt sich eine zusätzliche Methode namens HitTest zur Ermittlung eines ListItems unter explizit angegebenen Koordinaten komfortabel gestalten:
Public Function HitTest(ByVal Y As Single, _
Optional ByVal ScaleMode As Integer = vbTwips, _
Optional ByVal X As Single) As Long
HitTest = zGetIndex(X, Y, ScaleMode)
End Function
Der Parameter ScaleMode ist optional - standardmäßig wird Twips als Maßeinheit angenommen. Ebenfalls optional ist die Übergabe der X-Koordinate, da diese bei einer einspaltigen ListBox ohne Relevanz ist.
Damit Sie gegebenenfalls die Weitergabe der Mausereignisse abschalten können, verfügt das Steuerelement dazu über die Eigenschaft Enabled:
Private pEnabled As Boolean
Public Property Get Enabled() As Boolean
Enabled = pEnabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
pEnabled = New_Enabled
PropertyChanged "Enabled"
End Property
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
pEnabled = PropBag.ReadProperty("Enabled", True)
'...
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Enabled", pEnabled, True
'...
End Sub
Als kleines Extra können Sie über die Eigenschaft ItemHeight dieses Steuerelement auch noch die Höhe der ListItems ermitteln und auch ändern. Auch hier können Sie optional eine beliebige Maßeinheit angeben. Wegen des optionalen Parameters erscheint die Eigenschaft jedoch nicht im Eigenschaftenfenster und kann daher nur zur Laufzeit gesetzt oder gelesen werden.
Public Property Get ItemHeight(Optional ByVal ScaleMode As _
Integer = vbTwips) As Single
Dim nItemHeight As Long
Const LB_GETITEMHEIGHT = &H1A1
nItemHeight = SendMessage(eListBox.hWnd, LB_GETITEMHEIGHT, 0, 0)
ItemHeight = UserControl.ScaleY(nItemHeight, vbPixels, ScaleMode)
End Property
Public Property Let ItemHeight(Optional ByVal ScaleMode As _
Integer = vbTwips, ByVal New_ItemHeight As Single)
Dim nItemHeight As Long
Const LB_SETITEMHEIGHT = &H1A0
nItemHeight = UserControl.ScaleY(New_ItemHeight, ScaleMode, _
vbPixels)
With eListBox
SendMessage .hWnd, LB_SETITEMHEIGHT, 0, nItemHeight
.Refresh
End With
End Property
|