[INCLUDE]
GetTextOutWidth
Ellipsis_TextEnd

[CODE]
Public Function Ellipsis_PathSmartStart(ByVal hDC As Long, ByVal xPath As String, ByVal MaxWidthPX As Long) As String
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xChar1 As String
  Dim xChar2 As String
    
  If GetTextOutWidth(hdc, xPath) > MaxWidthPX Then
    If Left(xPath, 2) = "\\" Then xLong1 = 2&
    xLong1 = InStr(xLong1 + 1&, xPath, "\")
    If xLong1 = 0& Then
      xPath = "\" + xPath
      GoTo NoPathFix
      End If
    xChar1 = Left(xPath, xLong1)
    xPath = Mid(xPath, xLong1 + 1&)
      
    xLong1 = InStr(xPath, "\")
    If xLong1 = 0& Then
      xPath = "\" + xPath
      GoTo NoPathFix
      End If
    xChar2 = Left(xPath, xLong1 - 1&)
    xPath = Mid(xPath, xLong1)
    xLong2 = Len(xChar2) - 1&
    Do Until (xLong2 < 0&)
      Ellipsis_PathSmartStart = xChar1 + Left(xChar2, xLong2) + "..." + xPath
'Debug.Print "Test:", Ellipsis_PathSmartStart
      If GetTextOutWidth(hdc, Ellipsis_PathSmartStart) <= MaxWidthPX Then GoTo FoundIt
      xLong2 = xLong2 - 1&
      Loop
      
    xLong1 = InStrRev(xPath, "\")
    If xLong1 > 1& Then
      xChar2 = Left(xPath, xLong1 - 1&)
      xPath = Mid(xPath, xLong1)
      If GetTextOutWidth(hdc, xPath) < MaxWidthPX Then
        'else SkipSomePathing
ReLoopLAN:
        xLong2 = Len(xChar2) - 1&
        Do Until (xLong2 < 0&)
          Ellipsis_PathSmartStart = xChar1 + "..." + Right(xChar2, xLong2) + xPath
'Debug.Print "Test:", Ellipsis_PathSmartStart
          If GetTextOutWidth(hDC, Ellipsis_PathSmartStart) <= MaxWidthPX Then GoTo FoundIt
          xLong2 = xLong2 - 1&
          Loop

        If Left(xChar1, 2&) = "\\" And Len(xChar1) > 4& Then
          xChar1 = "\\"
          GoTo ReLoopLAN
          End If
        End If
NoPathFix:
      Ellipsis_PathSmartStart = Ellipsis_TextEnd(hDC, Mid(xPath, 2&), MaxWidthPX)
      End If
FoundIt:
    Else
    Ellipsis_PathSmartStart = xPath
    End If
  End Function
