devxlogo

CompactPathToWindow – Shorten a path so that it fits a window’s width

CompactPathToWindow – Shorten a path so that it fits a window’s width

Private Type RECT    Left As Long    Top As Long    Right As Long    Bottom As LongEnd TypePrivate Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _    lpRect As RECT) As LongPrivate Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function PathCompactPath Lib "shlwapi.dll" Alias _    "PathCompactPathA" (ByVal hDC As Long, ByVal lpszPath As String, _    ByVal dx As Long) As Boolean' shorten a path by using ellipses, if necessary,' so that it fits inside a window' if maxWidth=-1 or omitted, it uses the entire window's widthFunction CompactPathToWindow(ByVal sPath As String, ByVal hWnd As Long, _    Optional ByVal maxWidth As Long = -1) As String    Dim rc As RECT        ' Illegal function call if hWnd isn't a valid window handle    If IsWindow(hWnd) = 0 Then Err.Raise 5           ' if 3rd argument is omitted, use windows' width    If maxWidth 'get the rect of the target window        GetClientRect hWnd, rc        maxWidth = rc.Right - rc.Left    End If        ' compact the path    PathCompactPath GetWindowDC(hWnd), sPath, maxWidth        ' get the path by extracting it from the returned buffer    CompactPathToWindow = Left$(sPath, InStr(sPath & vbNullChar, _        vbNullChar) - 1)    End Function

devx-admin

Share the Post: