|
Die DirListBox ist ja eigentlich nichts anderes als eine ListBox.
Sie hat aber gegenüber dieser ein paar Besonderheiten, so dass sich
einige der bekannten ListBox-Tricks nicht bei ihr anwenden lassen.
So liefert zwar der Aufruf der API-Funktion  SendMessage
mit der Nachricht LB_ITEMFROMPOINT
den korrekten Index des Elements an der betreffenden Position. Doch
mit diesem Index können Sie nichts anfangen, da die DirListBox eine
eigene Nummerierung der Elemente verwaltet, die vom jeweils
geöffneten Ordner abhängt. Dieser hat nämlich immer den ListIndex
-1. Und die darüber liegenden Ordner-Ebenen werden von dort
weiter negativ gezählt, während die Unterordner des geöffneten
Ordners wie eigentlich gewohnt mit 0 beginnend aufwärts gezählt
werden.
Leider bietet die DirListBox keine Eigenschaft, aus der sich
irgendeine Relation dieser abweichenden Zählung zum eigentlichen
Index direkt ableiten ließe. Die offensichtlich einzige
Möglichkeit, die sich in der negativen Zählung der übergeordneten
Ordner widerspiegelnde Pfadtiefe zu ermitteln, besteht darin, den
aktuellen Pfad zu splitten und die Anzahl der sich so ergebenden
Teile von dem über LB_ITEMFROMPOINT ermittelten Index abzuziehen.
Der Hilfsfunktion DirListItemFromPoint, die diese Ermittlungen
und Berechnungen kapselt, übergeben Sie die betreffende DirListBox
und den Wert der Y-Koordinate, zu der der ListIndex ermittelt werden
soll. Da der ListIndex-Wert -1 hier nicht wie üblich
bedeuten kann, dass kein gültiger ListIndex ermittelt werden
konnte, muss die Funktion in diesem Fall einen anderen eindeutigen
Wert zurückgeben. Wir haben dafür den höchstmöglichen negativen
Long-Wert gewählt: &H80000000 (dlifpNoListIndex in der
Enumeration DirListItemFromPointConstants).
Private Type PointInt
X As Integer
Y As Integer
End Type
Private Type LongType
l As Long
End Type
Private Declare Function SendMessageLong Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Enum DirListItemFromPointConstants
dlifpNoListIndex = &H80000000
dlifpPathListIndex = -1
End Enum
Public Function DirListItemFromPoint(DirList As DirListBox, _
ByVal Y As Single) As Long
Dim nPoint As PointInt
Dim nL As LongType
Dim nItemPos As Long
Dim nParts() As String
Dim nItem As Long
Const LB_ITEMFROMPOINT = &H1A9
With DirList
nPoint.Y = Y \ Screen.TwipsPerPixelY
LSet nL = nPoint
nItemPos = SendMessageLong(.hwnd, LB_ITEMFROMPOINT, 0&, nL.l)
If Left$(.Path, 2) = "\\" Then
nParts = Split(Mid$(.Path, 3), "\")
nItem = nItemPos - UBound(nParts)
Else
nParts = Split(.Path, "\")
If Len(nParts(1)) = 0 Then
nItem = nItemPos - UBound(nParts)
Else
nItem = nItemPos - UBound(nParts) - 1
End If
End If
If nItem > .ListCount - 1 Then
DirListItemFromPoint = dlifpNoListIndex
Else
DirListItemFromPoint = nItem
End If
End With
End Function
Anhand der Anzahl der Pfadteile lässt sich auch der ListIndex
des Wurzelverzeichnisses und ermitteln:
Public Function DirListRootListIndex(DirList As DirListBox) As Long
Dim nParts() As String
With DirList
If Left$(.Path, 2) = "\\" Then
nParts = Split(Mid$(.Path, 3), "\")
DirListRootListIndex = -UBound(nParts)
Else
nParts = Split(.Path, "\")
If Len(nParts(1)) = 0 Then
DirListRootListIndex = -UBound(nParts)
Else
DirListRootListIndex = -UBound(nParts) - 1
End If
End If
End With
End Function
Und wenn Sie den Wurzelpfad benötigen:
Public Function DirListRoot(DirList As DirListBox) As String
DirListRoot = DirList.List(DirListRootListIndex(DirList))
End Function
Als kleines Extra hier noch die Funktion DirListPathFolders. Sie
liefert eine Collection der im aktuellen Pfad enthaltenen Ordner,
wahlweise als vollständige Pfadnamen oder nur als Ordnernamen, und
wahlweise mit oder ohne abschließenden Backslash.
Public Function DirListPathFolders(DirList As DirListBox, _
Optional ByVal FullPaths As Boolean = True, _
Optional ByVal AddBS As Boolean) As Collection
Dim nPathFolders As Collection
Dim l As Long
Dim nLenPath As String
Set nPathFolders = New Collection
With DirList
If FullPaths Then
If AddBS Then
For l = 0 To .ListCount - 1
nPathFolders.Add zPathPlusBS(.List(l))
Next 'l
Else
For l = 0 To .ListCount - 1
nPathFolders.Add .List(l)
Next 'l
End If
Else
If Right$(.Path, 1) = "\" Then
nLenPath = Len(.Path) + 1
Else
nLenPath = Len(.Path) + 2
End If
If AddBS Then
For l = 0 To .ListCount - 1
nPathFolders.Add zPathPlusBS(Mid$(.List(l), nLenPath))
Next 'l
Else
For l = 0 To .ListCount - 1
nPathFolders.Add Mid$(.List(l), nLenPath)
Next 'l
End If
End If
End With
Set DirListPathFolders = nPathFolders
End Function
Die Hilfsfunktion zPathPlusBS sorgt dafür, dass ein übergebener
Pfad immer mit genau einem Backslash endet:
Private Function zPathPlusBS(iPath As String) As String
Select Case Right$(iPath, 1)
Case "\"
zPathPlusBS = iPath
Case Else
zPathPlusBS = iPath & "\"
End Select
End Function
|