Tipp 10.6 - Pfad kürzen

Wie kann ich einen Pfad bis zu einer Maximallänge kürzen?

Mit dieser Funktion können Sie einen Pfad bis zu einer Maximallänge kürzen. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: DrawText - RECT

Beispiel:

Option Explicit
 
Private Type RECT
             Left   As Long
             Top    As Long
             Right  As Long
             Bottom As Long
End Type
 
Private Const DT_PATH_ELLIPSIS  As Long = &H4000&
Private Const DT_SINGLELINE     As Long = &H20&
Private Const DT_MODIFYSTRING   As Long = &H10000
Private Const DT_FITPATH        As Long = _
              DT_PATH_ELLIPSIS Or _
              DT_SINGLELINE Or _
              DT_MODIFYSTRING
 
Private Declare Function DrawText Lib "user32" Alias _
                        "DrawTextA" _
                        (ByVal hDC As Long, _
                         ByVal lpStr As String, _
                         ByVal nCount As Long, _
                               lpRect As RECT, _
                         ByVal wFormat As Long) As Long
 
Public Function FitPath(ByVal sCompletePath As String, _
                        ByVal lMaxLength As Long, _
                        ByVal hDC As Long) As String
'// --------------------------------------------------------
'// Methode:   | Gegebener Pfad wird bis zu einer
'//            | Maximallänge in Twips gekürzt.
'// --------------------------------------------------------
'// Parameter: | sCompletePath - zu kürzender Pfad
'//            | lMaxLength    - Maximallänge
'//            | hDC           - gültiger DC
'// --------------------------------------------------------
'// Rückgabe:  | Gekürzter Pfad
'// --------------------------------------------------------
'// Beispiel:
'// --------------------------------------------------------
'// Const csPATH As String = _
'//     "C:\Programme\Microsoft Visual Studio\VB98\VB6.EXE"
'// Dim lMaxLength  As Long
'// Dim lDC         As Long
'// lDC = Me.hDC 'in einer Form!
'// lMaxLength = ctrTextbox.Width \ Screen.TwipsPerPixelX
'// ctrTextbox.Text = FitPath(csPATH, lMaxLength, lDC)
'// --------------------------------------------------------
'// Autor:     | Stefan Kulpa
'//            | EDV Innovation & Consulting - Dormagen
'// --------------------------------------------------------
    Dim uRect As RECT
    uRect.Right = lMaxLength
    DrawText hDC, _
             sCompletePath, _
             -1, _
             uRect, _
             DT_FITPATH
    FitPath = sCompletePath
 
End Function