ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 27.10.2000

Diese Seite wurde zuletzt aktualisiert am 27.10.2000
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicActiveX-Komponenten, Controls, Klassen und mehr...AddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zum ABOUT Visual Basic-Magazin, Kontakt und Impressum

Zurück...

Dir unter dem Mauszeiger

Zurück...


Anzeige

(-hg) mailto:hg_dirlistitemfrompoint@aboutvb.de

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 MSDN Library - API SendMessageSendMessage mit der Nachricht MSDN Library - API LB_ITEMFROMPOINTLB_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

Modul und Beispiel-Projekt DirListItemFromPoint (dirlistitemfrompoint.zip - ca. 4,5 KB)


Artikel
Zum Download-Bereich dieses Artikel
Mail an den Autor dieses Artikels

KnowHow
Zur KnowHow-Übersicht

KnowHow-Themen
Themen - Allgemeines
Themen - Entwicklungsumgebung (VB-IDE)
Themen - Forms
Themen - Steuerelemente (Controls)
Themen - Grafik
Themen - Dateien
Themen - UserControls
Themen - Einsteiger-Tipps
Themen - Wussten Sie...?

Übersicht nach Titeln in alphabetischer Reihenfolge
Übersicht nach Erscheinungsdatum

Schnellsuche



Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer