?
Solved

How do I shorten a path name

Posted on 2003-03-24
22
Medium Priority
?
1,883 Views
Last Modified: 2008-03-03
I want to shorten a path name to a limited amount of characters and replace the center of the string with ellipsis like this:

Input string:
c:\program files\directory1\directory2\directory3\file.name

Output stringL
c:\program file\..\directory3\file.name

I would accept the answer either by the number of characters or the first and last directory plus the filename.
0
Comment
Question by:mdlittle
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
  • 4
  • +3
22 Comments
 
LVL 2

Expert Comment

by:Zip58
ID: 8197704
Hi mdlittle

Mabey you can try this

This function, when passed a long path name, will convert it to a short Win3.1 style path name.  For example: ExtractShortPathName('C:\This is a directory\This is a file.txt') will return 'C:\Thisis~1\Thisis~1.txt'.  To extract the long path name, see ExtractLongPathName().

function ExtractShortPathName(const FileName: string): string;
{ func to shorten the long path name to look like Win 3.1 naming conventions. }
{ If file doesn't exist, func will return an emtpy string.                    }
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  SetString(Result, Buffer,
    GetShortPathName(PChar(FileName), Buffer, SizeOf(Buffer)));
end;

Regards

Zip58


0
 
LVL 6

Expert Comment

by:DaFox
ID: 8197717
Hi mdlittle!

Looks like you are searching for a function like MinimizeName()?

{ uses FileCtrl }

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
begin
  s := 'c:\program files\directory1\directory2\directory3\file.name';
  Label1.Caption := MinimizeName(s, Label1.Canvas, Label1.Width);
end;

Markus
0
 
LVL 2

Expert Comment

by:Zip58
ID: 8197727
Hi mdlittle

Take also a look to this

function MinimizePathName(Wnd: HWND; const Filename: string): string;
{ func to shorten the long path name with an ellipses '...' to fit }
{ in whatever control is passed to the Wnd parameter. }
{ Usage: Panel1.Caption := MinimizePathName(Panel1.Handle, DirectoryOutline1.Directory) }
{ This will shorten the path if necessary to fit in Panel1. }
procedure CutFirstDirectory(var S: string);
var
Root: Boolean;
P: Integer;
begin
if S = '\' then
S := ''
else
begin
if S[1] = '\' then
begin
Root := True;
Delete(S, 1, 1);
end
else
Root := False;
if S[1] = '.' then
Delete(S, 1, 4);
P := Pos('\',S);
if P <> 0 then
begin
Delete(S, 1, P);
S := '...\' + S;
end
else
S := '';
if Root then
S := '\' + S;
end;
end;

function GetTextWidth(DC: HDC; const Text: String): Integer;
var
Extent: TSize;
begin
if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then
Result := Extent.cX
else
Result := 0;
end;

var
Drive,
Dir,
Name: string;
R: TRect;
DC: HDC;
MaxLen: integer;
OldFont, Font: HFONT;
begin
Result := FileName;

if Wnd = 0 then
Exit;

DC := GetDC(Wnd);
if DC = 0 then
Exit;

Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
OldFont := SelectObject(DC, Font);
try
GetWindowRect(Wnd, R);
MaxLen := R.Right - R.Left;

Dir := ExtractFilePath(Result);
Name := ExtractFileName(Result);

if (Length(Dir) >= 2) and (Dir[2] = ':') then
begin
Drive := Copy(Dir, 1, 2);
Delete(Dir, 1, 2);
end
else
Drive := '';

while ((Dir <> '') or (Drive <> '')) and (GetTextWidth(DC, Result) > MaxLen) do
begin
if Dir = '\...\' then
begin
Drive := '';
Dir := '...\';
end
else
if Dir = '' then
Drive := ''
else
CutFirstDirectory(Dir);
Result := Drive + Dir + Name;
end;
finally
SelectObject(DC, OldFont);
ReleaseDC(Wnd, DC);
end;
end;

Ps.( not tested)

Regards

Zip58
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Expert Comment

by:jbshumate
ID: 8197750
var
  ii : integer;
  count : integer;
  start,stop : integer;
begin
  count := 0;
  start := 0;
  stop := 0;
  for ii := 1 to length(fPath) do begin
    // look for all the separators
    if fPath[ii] = '\'  then begin
      count := count + 1;  // count them
      if count = 2 then start := ii + 1  // 2nd is start
      else stop := ii;
    end;
  end;
  if (count > 2) and (stop > (start + 2)) then begin
    // we had at least 3 separators and can shorten
    fPath[start] := '.';
    fPath[start+1] := '.';
    fPath[start+2] := '.';
    start := start + 3;  // elipses
    for ii := stop to length(fPath) do begin
      // copy the last separator and the filename
      fPath[start] := fPath[ii];
      start := start + 1;
    end;
    setLength(fPath,start-1);  // shorten the string
  end;
end;
   
0
 

Author Comment

by:mdlittle
ID: 8197984
jbshumate:

Not sure how this works. I tried it and the string is truncated.

0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 1000 total points
ID: 8198071
a sample

unit Shorten_Path_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//this simple function returns the first part as result,
//and shorten the given string
//for next item simple call again
//if there are no items, then the given string becomes empty
function SplitStr(Var AString : String; ADelim : String) : String;
var APos : Integer;
begin
  Result := '';
  APos := Pos(ADelim,AString);
  if APos > 0 then
  begin
    Result := Copy(AString,1,APos-1);
    AString := copy(Astring,APos+length(Adelim),MaxLongInt);
  end
  else
  begin
    Result := AString;
    AString := '';
  end;
end;

//This function shorten the path
function shorten_Path(APath : String) : String;
var
  sl : TstringList;
  s : string;
begin
  s := APath;
  result := APath;
  sl := TstringList.Create;
  try
    while s <> '' do
      sl.add(SplitStr(s,'\'));
    if sl.count > 4 then
      result := sl[0]+'\'+sl[1]+'\...\'+sl[sl.count-2]+'\'+sl[sl.count-1];
  finally
    sl.free;
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  edit2.text := Shorten_Path(edit1.text);
end;

end.

meikl ;-)
0
 
LVL 6

Expert Comment

by:DaFox
ID: 8198099
Meikl, what about using TStrings instead of TStringList (-> speed increase!)?

Markus
0
 
LVL 1

Expert Comment

by:jbshumate
ID: 8198263
How did you use the code.  If you just typed it in as I gave it the compiler probably eliminated the final result since it was not used.  Here it is wrapped as a procedure and should work if you just cut and paste.


procedure Shorten(var fPath : string);
var
 ii : integer;
 count : integer;
 startPos,stop : integer;
begin
 count := 0;
 startPos := 0;
 stop := 0;
 for ii := 1 to length(fPath) do begin
   // look for all the separators
   if fPath[ii] = '\'  then begin
     count := count + 1;  // count them
     if count = 2 then startPos := ii + 1  // 2nd is start
     else stop := ii;
   end;
 end;
 if (count > 2) and (stop > (startPos + 2)) then begin
   // we had at least 3 separators and can shorten
   fPath[startPos] := '.';
   fPath[startPos+1] := '.';
   fPath[startPos+2] := '.';
   startPos := startPos + 3;  // elipses
   for ii := stop to length(fPath) do begin
     // copy the last separator and the filename
     fPath[startPos] := fPath[ii];
     startPos := startPos + 1;
   end;
   setLength(fPath,startPos - 1);  // shorten the string
 end;
end;
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 8198343
markus,

>what about using TStrings instead of TStringList
>(-> speed increase!)?

tsrings is a abstract class,
some methods are only abstract declared,
and must be implemented in a derived class
-> thats why i use tstringslist

it may be, that the methods i used,
 are already implemented in tstrings,
but i guess the speed increasement,
if there is one, may not significant.

meikl ;-)
0
 
LVL 1

Expert Comment

by:jbshumate
ID: 8198395
Ok, lets try this again.  I just re-read your original request and realized I was only giving you the filename and not the last directory as well.  The following should work.

procedure Shorten(var fPath : string);
var
 ii : integer;
 count : integer;
 startPos,stop : integer;
 prevStop : integer;
begin
 count := 0;
 startPos := 0;
 stop := 0;
 prevStop := 0;
 for ii := 1 to length(fPath) do begin
   // look for all the separators
   if fPath[ii] = '\'  then begin
     count := count + 1;  // count them
     if count = 2 then startPos := ii + 1  // 2nd is start
     else begin
       prevStop := stop;
       stop := ii;
     end;
   end;
 end;
 if (count > 3) and (prevStop > (startPos + 2)) then begin
   // we had at least 4 separators and can shorten
   fPath[startPos] := '.';
   fPath[startPos+1] := '.';
   fPath[startPos+2] := '.';
   startPos := startPos + 3;  // elipses
   for ii := prevStop to length(fPath) do begin
     // copy the last separator and the filename
     fPath[startPos] := fPath[ii];
     startPos := startPos + 1;
   end;
   setLength(fPath,startPos - 1);  // shorten the string
 end;
end;
0
 
LVL 6

Expert Comment

by:DaFox
ID: 8198504
Meikl, you're right, of course. It was more a theoretical objection; I always try to get rid of TStringLists in such trivial cases (no matter if speed increase is insignificant or not.

Markus
0
 
LVL 1

Expert Comment

by:merry_prince
ID: 8199780
Jbshumate, Good solution.
0
 
LVL 1

Expert Comment

by:merry_prince
ID: 8199932
Hi Jbshumate,
Input string:
'c:\Program\c\d\a.exe'
Shorten proc can't dispose above path and will return original string. Should you update the proc to meet Mdlittle's request?
0
 
LVL 1

Expert Comment

by:merry_prince
ID: 8199940
Just a suggestion. It doesn't matter.
0
 
LVL 1

Expert Comment

by:jbshumate
ID: 8199995
merry prince

Your example would not in fact shorten based on his request.  The result would be c:\Program\...\d\a.exe.  I wrote the code to only operate if the result was shorter.
0
 
LVL 1

Expert Comment

by:merry_prince
ID: 8200313
Just a suggestion. It doesn't matter.
0
 
LVL 6

Expert Comment

by:DaFox
ID: 8202721
btw: If someone uses/tests my code above: Set the autosize property of the label to false... (otherwise you'll just get the filename without the path ... not very useful then)

Markus
0
 

Author Comment

by:mdlittle
ID: 8205449
OK. The label thing will not work for me. I am not sending the short string to a label or any other control. This is not what I want. I am testing Jbshumate's and Meikl's code now.

Thanks
0
 

Author Comment

by:mdlittle
ID: 8205531
kretzschmar:

Very good  - works very well. Also works well for directory names as changed below;

result := sl[0]+'\'+sl[1]+'\...\' +sl[sl.count-1] + '\';
0
 
LVL 1

Expert Comment

by:jbshumate
ID: 8205673
Glad to see you found something you like.  For what it is worth the code you chose is probably 1 to 2 orders of magnitude slower than what I showed you since it requires procedure calls, creation of a string list, try..except blocks etc.  As long as you are only doing this occasionally that would be no problem.  If you are using this to navigate a large number of paths and populate a treeView or some such you may want to keep this is mind.
0
 

Author Comment

by:mdlittle
ID: 8205785
jbshumate:

I do appreciate the suggestion and help with the question. It would be nice if you could also award points for effort and assistance.

I will watch for you name the next time I post a question.

Thanks again

Mike
0
 
LVL 1

Expert Comment

by:merry_prince
ID: 8207652
I agreed with jbshumate. His proc is smart. Since no need to create and free object resource.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question