Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
Nov 18, 2000



Building the Right Environment to Support AI, Machine Learning and Deep Learning

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 Long
End Type
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _
    lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private 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 width

Function 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 < 0 Then
        '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
Marco Bellinaso
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date