[Aндрей]

Мне в программе нужно укоротить путь до папки (использую TShellTreeView). Так вот, пробовал тренироваться на эдитах:
Edit1.Text:= TShellTreeView.Path;

Код:

function ShortFileName(const FileName: string): string;
var aTmp: array[0..255] of Char;
begin
  if not DirectoryExists(FileName)  //FileExists(FileName)
    then Result:=''
    else if GetShortPathName(PChar(FileName), aTmp, Sizeof(aTmp)-1) = 0
      then Result:= FileName
      else Result:= StrPas (aTmp);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Edit2.Text:=(ShortFileName(Edit1.Text));
end;

Почему-то он возвращает в Edit2 пустое значение.. Подскажите что ни так?

[roamer]

Да вроде бы работает Ваша функция :

Код:

function ShortFileName(const FileName: string): string;
var
  aTmp: array[0..255] of Char;
begin
  if not FileExists(FileName) then begin
     Result:='';
  end
  else begin
     if GetShortPathName(PChar(FileName), aTmp, Sizeof(aTmp)) = 0 then begin
        Result:= FileName;
     end
     else begin
        Result:= StrPas (aTmp);
     end;
  end;
end;

На входе :
D:\Мои документы\Санитарные_правила_и_нормы\СанПиН-2_2_4_1294-03.2003-06-15\СанПиН-2_2_4_1294-03-20030615.htm

На выходе :
D:\МОИДОК~1\САНИТА~1\САНПИН~2.200\САНПИН~1.HTM

[Aндрей]

Как я понял, обязательно должен существовать файл, к которому указывается путь. А можно как-нидуть сделать, чтобы просто путь укарачивался?
Например:
D:\Мои документы\Санитарные_правила_и_нормы\СанПиН-2_2_4_1294-03.2003-06-15\

[Aндрей]

У меня просто в программе указывается путь к файлу, который еще не существует

[roamer]

А разве здесь не подойдет ExtractFilePath(...) ?

[PhoeniX]

Элементарно, Ватсон:

Код:

function ShortFileName(const FileName: string): string;
var
  aTmp: array[0..255] of Char;
begin
 if GetShortPathName(PChar(FileName), aTmp, Sizeof(aTmp)) = 0 then begin
      Result:= FileName;
   end
   else begin
      Result:= StrPas (aTmp);
   end;
end;

[roamer]

Вот так тоже сработало :

Код:

function GetShortFileName(fnFull : string): string;
var
  aTmp: array[0..255] of Char;
begin
  Result:='';
  //if FileExists(fnFull) then begin
     if GetShortPathName(PChar(fnFull), aTmp, Sizeof(aTmp)) = 0 then begin
        Result:= fnFull;
     end
     else begin
        Result:= StrPas(aTmp);
     end;
  //end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetShortFileName('D:\Мои документы\Санитарные_правила_и_нормы\СанПиН-2_2_4_1294-03.2003-06-15\'));
end;

На выходе :
D:\МОИДОК~1\САНИТА~1\САНПИН~2.200\

[roamer]

Мир тесен - пересеклись в едином мнении и почти одновременно ...
Что-то в этом есть
:-)

[Aндрей]

Большое большое спасибо!

[AlexSku]

Есть функции API, которые сами ставят многоточие. Вот пример. Я, правда, не совсем знаком с хэндлами и у меня получился немного больший по размеру шрифт, но кто-нибудь вам подскажет.

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  dc: HDC;
  Rect: TRect;
  S:    String;
begin
  S:= 'D:\Мои документы\Санитарные_правила_и_нормы\СанПиН-2_2_4_1294-03.2003-06-15\';
  dc:=GetWindowDC(Edit1.Handle);
  Rect:= Edit1.ClientRect;
  DrawText(dc,
    PAnsiChar(S),
    Length(S),
    Rect,
    DT_PATH_ELLIPSIS);  //    DT_END_ELLIPSIS
  ReleaseDC(Edit1.Handle,dc);
end;

Флаг DT_PATH_ELLIPSIS ставит многоточие в середине (правило в справке), а флаг DT_END_ELLIPSIS - в конце.