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.
Verwendete 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