PureBasic Forums - English

Posted: **Mon Sep 25, 2006 9:16 pm**

Code updated For 5.20+

Here's a quick little one - a function that takes in a full pathname & filename and will return a shortened version of the path & filename based on the length you pass.

So, a call like ...

Code: Select all

Debug ShortenPath("C:\Programs\Projects\Misc\AutocompletePop.pb", 40)

... will result in 'C:\...\Projects\Misc\AutocompletePop.pb' and ...

Code: Select all

Debug ShortenPath("C:\Programs\Hide\Me\From\View\Projects\Misc\PopAutocomplete\New Microsoft Word Document That Contains A Ridiculously Long File Name.doc", 40)

... will result in 'C:\...\New Microsoft Word Document Th...'

Probably not the fastest most bestest method out there but it's what I'm using at the moment. I welcome others

Code: Select all

Procedure.s ShortenPath(File.s, MaxLength.l)
   ;
   Define.l iCount
   ;
   Define.s HoldString = File
   ;
   Define.l HoldLength = Len(HoldString)
   ;
   Define.l HoldIndex = FindString(File, "\", 1)
   ; Locate the first directory delimiter.
   Define.l HoldSecond = FindString(File, "\", HoldIndex + 1)
   ; Locate the second directory delimiter.  The text between the two delimiters is one directory.
   While HoldSecond
      ; Only loop while subdirectories exist.
      If HoldLength <= MaxLength : ProcedureReturn HoldString : EndIf
      ; Ensure the passed path length is larger than the maximum allowed.
      While HoldLength > MaxLength
         ;
         iCount + 1
         ;
         If iCount > 1
            ;
            HoldString = Left(HoldString, 6) + Mid(HoldString, HoldSecond, HoldLength - HoldSecond + 1)
            ; 
            HoldLength = Len(HoldString)
            ;
            HoldSecond = FindString(HoldString, "\", HoldIndex + 1)
            ;
         Else
            ;
            HoldString = Mid(HoldString, 1, HoldIndex) + "..." + Mid(HoldString, HoldSecond, HoldLength - HoldSecond + 1)
            ;
            HoldLength = Len(HoldString)
            ;
            HoldIndex = FindString(HoldString, "\", HoldIndex + 4)
            ;
            HoldSecond = FindString(HoldString, "\", HoldIndex + 1)
            ;
         EndIf
         ;
         Break
         ;
      Wend
      ;
   Wend
   ;
   If HoldLength > MaxLength : HoldString = Left(HoldString, MaxLength - 3)+"..." : EndIf
   ;
   ProcedureReturn HoldString
   ;
EndProcedure

Posted: **Mon Sep 25, 2006 10:24 pm**

Try this : http://www.purebasic.fr/english/viewtop ... rtpathname

Posted: **Mon Sep 25, 2006 10:58 pm**

Not the same thing. The GetShortPathName_() function will just return the 8.3 version of the directory/filename. Useful for MCI and other things but not what I'm going for here.

The aim of my function was to shorten a path using ellipses in order to fit it within a reasonable amount of characters to display onscreen. Like MS Word's recent file list.

Posted: **Tue Sep 26, 2006 9:32 am**

> The aim of my function was to shorten a path using ellipses in order to fit it
> within a reasonable amount of characters to display onscreen

To save 2 characters you can replace "..." with Chr(133) for a start.

Posted: **Tue Sep 26, 2006 2:10 pm**

If you are working strictly in Windows, there is an API function that
does this: PathCompactPath in "shlwapi.dll".

Regards,
Eric

Posted: **Wed Sep 27, 2006 11:20 am**

ebs,

thank you for pointing out the WinAPI function PathCompactPath(). Here is a code example with Xombie's path examples:

Code: Select all

Procedure DisplayShortenedPath(GadgetID.L, Path.S)
  Protected hDC.L
  Protected Result.L

  hDC = GetDC_(GadgetID(GadgetID))

  If hDC <> #False
    Result = PathCompactPath_(hDC, @Path, Int((GadgetWidth(GadgetID) - 8) / 72.0 * GetDeviceCaps_(hDC, #LOGPIXELSX)))
    SetGadgetText(GadgetID, Path)
    ReleaseDC_(WindowID(1), hDC)
  EndIf
EndProcedure


#WindowHeight = 105
#WindowWidth = 700

Path1.S = "C:\Programs\Projects\Misc\AutocompletePop.pb"
Path2.S = "C:\Programs\Hide\Me\From\View\Projects\Misc\PopAutocomplete\New Microsoft Word Document That Contains A Ridiculously Long File Name.doc"

If OpenWindow(1, 0, 0, #WindowWidth, #WindowHeight, "ShortenFilePath", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
  If CreateGadgetList(WindowID(1))
    TextGadget(1, 10, 10, #WindowWidth - 20, 18, Path1, #PB_Text_Border)
    TextGadget(2, 10, 30, #WindowWidth - 500, 18, "", #PB_Text_Border)
    TextGadget(3, 10, 60, #WindowWidth - 20, 18, Path2, #PB_Text_Border)
    TextGadget(4, 10, 80, #WindowWidth - 500, 18, "", #PB_Text_Border)

    DisplayShortenedPath(2, Path1)
    DisplayShortenedPath(4, Path2)

    Repeat
    Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
EndIf

Posted: **Wed Sep 27, 2006 8:58 pm**

Now see what y'all did? You made me waste time trying to beat the MS code

Didn't quite make it but I did speed up my routine while making it unicode compatible.

Code: Select all

Structure CHAR
   c.c
EndStructure
Procedure.s ShortenPath(File.s, MaxLength.l) 
   ;
   Protected HoldValue.l
   ;
   Protected *HoldChar.CHAR = @File
   ; Create a pointer to the string in order to store characters.
   While *HoldChar\c <> '\' And *HoldChar\c : *HoldChar + (1 << #PB_COMPILER_UNICODE) : Wend
   ; Search for the first directory delimiter.
   If *HoldChar\c
      ; Found the first '\' character.
      Protected HoldIndex.l
      ; Create a variable for the index.
      HoldIndex = *HoldChar
      ; Index of the first '\' character.
   Else
      ; No '\' character exists.  No directories to compact.
      If Len(File) > MaxLength : ProcedureReturn Left(File, MaxLength - 3) + "..." : Else : ProcedureReturn Left(File, MaxLength) : EndIf
      ; Return the path & filename truncated by the maximum number of characters.
   EndIf
   ;
   *HoldChar + (1 << #PB_COMPILER_UNICODE)
   ; Increment to the next character.
   While *HoldChar\c <> '\' And *HoldChar\c : *HoldChar + (1 << #PB_COMPILER_UNICODE) : Wend
   ; Search for the next directory delimiter.
   If *HoldChar\c
      ; A second '\' character exists.
      Protected HoldSecond.l
      ; Index of the second '\' character.
      HoldSecond = *HoldChar
      ; Store the address of the second '\' character.
   Else
      ; No second '\' character exists.  No directories to compact.
      If Len(File) > MaxLength : ProcedureReturn Left(File, MaxLength - 3) + "..." : Else : ProcedureReturn Left(File, MaxLength) : EndIf
      ; Return the path & filename truncated by the maximum number of characters.
   EndIf
   ;
   While *HoldChar\c : *HoldChar + (1 << #PB_COMPILER_UNICODE) : Wend
   ;
   Protected HoldLength.l = (*HoldChar - @File) >> #PB_COMPILER_UNICODE
   ; Get the length of the file.
   If HoldLength <= MaxLength : ProcedureReturn File : EndIf
   ; Return the full path & filename if it's less or equal to the max length allowed.
   Protected ReturnString.s = Space(HoldLength)
   ;
   *HoldChar = @ReturnString + ((((HoldIndex - @File) >> #PB_COMPILER_UNICODE) + 4) << #PB_COMPILER_UNICODE)
   ;
   HoldValue = ((HoldIndex - @File) >> #PB_COMPILER_UNICODE) + 1
   PokeS(@ReturnString, PeekS(@File, HoldValue), HoldValue)
   PokeS(@ReturnString + ((((HoldIndex - @File) >> #PB_COMPILER_UNICODE) + 1) << #PB_COMPILER_UNICODE), "...", 3 << #PB_COMPILER_UNICODE)
   HoldValue = HoldLength - ((HoldSecond - @File) >> #PB_COMPILER_UNICODE) + 1
   PokeS(*HoldChar, PeekS(HoldSecond, HoldValue), HoldValue)
   ;
   HoldLength = HoldLength - (((HoldSecond - HoldIndex) >> #PB_COMPILER_UNICODE) - 1) + 3
   ;
   HoldIndex = *HoldChar
   ;
   While HoldLength > MaxLength
      ;
      *HoldChar = HoldIndex + (1 << #PB_COMPILER_UNICODE)
      ;
      While *HoldChar\c <> '\' And *HoldChar\c : *HoldChar + (1 << #PB_COMPILER_UNICODE) : Wend
      ; Search for the next directory delimiter.
      If *HoldChar\c
         ; Another '\' character was located.  Directories remain in the string.
         HoldValue = HoldLength - ((*HoldChar - @ReturnString) >> #PB_COMPILER_UNICODE) + 1
         PokeS(HoldIndex, PeekS(*HoldChar, HoldValue), HoldValue)
         ;
         HoldLength = HoldLength - (((*HoldChar - HoldIndex) >> #PB_COMPILER_UNICODE) - 1) - 1
         ;
      Else
         ; No more '\' characters exist.
         PokeC(@ReturnString + (MaxLength << #PB_COMPILER_UNICODE), 0)
         ;
         If HoldLength > MaxLength
            PokeC(@ReturnString + ((MaxLength - 1) << #PB_COMPILER_UNICODE), '.')
            PokeC(@ReturnString + ((MaxLength - 2) << #PB_COMPILER_UNICODE), '.')
            PokeC(@ReturnString + ((MaxLength - 3) << #PB_COMPILER_UNICODE), '.')
         EndIf
         ; Return the path and filename truncated to maximum allowed length.
         ProcedureReturn ReturnString
         ;
      EndIf
      ;
   Wend
   ;
   ProcedureReturn ReturnString
   ;
EndProcedure

And the changed procedure from MS...

Code: Select all

Procedure.s DisplayShortenedPath(Path.s, MaxLength.l) 
   ;
   Protected Result.l
   ;
   Protected ReturnString.s = Space(255)
   ;
   Result = PathCompactPathEx_(@ReturnString, @Path, MaxLength + 1, 0)
   ;
   ProcedureReturn ReturnString
   ;
EndProcedure

And a little testing routine...

Code: Select all

#NumLoops = 100000
Define.l q, r, s, t, i
Define.s a, b, c, d
Path1.s = "C:\Programs\Projects\Misc\AutocompletePop.pb" 
Path2.s = "C:\Programs\Hide\Me\From\View\Projects\Misc\PopAutocomplete\New Microsoft Word Document That Contains a Ridiculously Long File Name.doc" 
Path3.s = "C:\Programs\Hide\Me\From\View\Projects\Misc\Pop\Auto\complete\Average Size.doc" 
;-
Delay(500)
q = GetTickCount_()
For i = 1 To #NumLoops
   a = ShortenPath(Path1, 40)
   b = ShortenPath(Path2, 40)
   c = ShortenPath(Path3, 40)
Next i
r = GetTickCount_()
s = r - q
Delay(500)
q = GetTickCount_()
For i = 1 To #NumLoops
   a = DisplayShortenedPath(Path1, 40)
   b = DisplayShortenedPath(Path2, 40)
   c = DisplayShortenedPath(Path3, 40)
Next i
r = GetTickCount_()
t = r - q
MessageRequester("", Str(s)+" : "+Str(t))
;-

I used the PathCompactPathEx_() function in this one as it more closely mirrors my own procedure. In that it returns a string without using any GDI stuff.

PureBasic Forums - English

Recent File Menu Path Shortening

Recent File Menu Path Shortening