by Matt Terry (3 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 10th October 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.
VBcoders
'MaxChars argument is the length of the displayable path name to return
'ShrinkChar optional argument is the character to use for shortened version ("." is default)
Public Function ShrinkFileName(ByVal NameToShrink As String, _
ByVal MaxChars As Integer, Optional ByVal ShrinkChar As String) As String
Dim HideChar As String, szFileName As String
Dim szDir() As String
Dim nDirs As Integer, nDir1 As Integer, nDir2 As Integer, nDir3 As Integer, nDir4 As Integer
Dim iCount As Integer
If Len(NameToShrink) < MaxChars Then
'No change needed
ShrinkFileName = NameToShrink
Exit Function
End If
'Set Hide Character
If Len(ShrinkChar) > 0 Then
HideChar = Left(ShrinkChar, 1) & _
Left(ShrinkChar, 1) & Left(ShrinkChar, 1)
Else
HideChar = "." & "." & "."
End If
'Split the file name
szDir() = Split(NameToShrink, "\")
nDirs = UBound(szDir)
If nDirs < 1 Then
'FileName can't be shrunk well, just
'chop off beginning characters to fit
ShrinkFileName = Right(NameToShrink, MaxChars)
Exit Function
End If
'Re-add the "\"s
For iCount = 1 To nDirs
szDir(iCount) = "\" & szDir(iCount)
Next iCount
If Len(szDir(nDirs)) >= MaxChars Or Len(szDir(0)) >= MaxChars Then
'FileName can't be shrunk well, just
'chop off the end of the file name
'to fit.
ShrinkFileName = Left(szDir(nDirs), MaxChars)
Exit Function
End If
'Start the shrunken FileName
ShrinkFileName = szDir(0)
'Get Section lengths
nDir1 = Len(szDir(0)) 'Drive Letter
nDir2 = Len(szDir(1)) 'First Directory or File Name
szFileName = szDir(1)
If nDirs > 1 Then
nDir3 = Len(szDir(2)) 'Second Directory of File Name
szFileName = szDir(2)
Else
nDir3 = 0
End If
If nDirs > 2 Then
nDir4 = Len(szDir(nDirs)) 'File Name
szFileName = szDir(nDirs)
Else
nDir4 = 0
End If
'Worst case scenario (of remaining)
If nDir1 + Len(szFileName) + Len(HideChar) > MaxChars Then
ShrinkFileName = szFileName
Exit Function
End If
'Next best
ShrinkFileName = ShrinkFileName & HideChar & szFileName
If Len(ShrinkFileName) + nDir2 >= MaxChars Or nDir2 < 1 Then
Exit Function
Else
ShrinkFileName = szDir(0) & szDir(1) & HideChar & szFileName
End If
'Next best
If Len(ShrinkFileName) + nDir3 >= MaxChars Or nDir3 < 1 Then
Exit Function
Else
ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & HideChar & szFileName
End If
'Best case scenario
If Len(ShrinkFileName) + nDir4 <= MaxChars Then
ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & szDir(3) & HideChar & szFileName
End If
End Function
No comments have been posted about Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.. Why not be the first to post a comment about Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes..