VPF::Вывод длинного имени файла на экран

Matematik

Дата 16.6.2008, 16:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

Надо вывести в TLabel длинное имя файла
типа - C:\Documents and Settings\Вася\Мои документы\Borland Studio Projects\proj1\opt\file.txt
в коротком виде C:\...\file.txt или C:\...\opt\file.txt в соответствии с длиной TLabel

Точно знаю есть стандартная ф-я, не могу найти.

pseud

Дата 16.6.2008, 17:33 (ссылка)

(нет голосов)

Загрузка ...

Экспёрт Тыдыщ

Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40

Цитата(Matematik @ 16.6.2008, 16:58

)

Точно знаю есть стандартная ф-я, не могу найти.

интересно, какой параметр в эту стандартную функцию передается

Добавлено через 14 минут и 35 секунд
Delphi World 6 Pro в помощь:

Цитата

Следующие три функции помогут преобразовать длинные имена файлов в коротки и наоборот. Функция Mince служит для отображения полного имени файла, включая путь.

Код


{=========================================================} 
Function Mince(PathToMince: String; InSpace: Integer): String; 
{=========================================================} 
// "C:\Program Files\Delphi\DDrop\TargetDemo\main.pas" 
// "C:\Program Files\..\main.pas" 
Var 
  sl: TStringList; 
  sHelp, sFile: String; 
  iPos: Integer; 

Begin 
  sHelp := PathToMince; 
  iPos := Pos('\', sHelp); 
  If iPos = 0 Then 
  Begin 
    Result := PathToMince; 
  End 
  Else 
  Begin 
    sl := TStringList.Create; 
    // Decode string 
    While iPos <> 0 Do 
    Begin 
      sl.Add(Copy(sHelp, 1, (iPos - 1))); 
      sHelp := Copy(sHelp, (iPos + 1), Length(sHelp)); 
      iPos := Pos('\', sHelp); 
    End; 
    If sHelp <> '' Then 
    Begin 
      sl.Add(sHelp); 
    End; 
    // Encode string 
    sFile := sl[sl.Count - 1]; 
    sl.Delete(sl.Count - 1); 
    Result := ''; 
    While (Length(Result + sFile) < InSpace) And (sl.Count <> 0) Do 
    Begin 
      Result := Result + sl[0] + '\'; 
      sl.Delete(0); 
    End; 
    If sl.Count = 0 Then 
    Begin 
      Result := Result + sFile; 
    End 
    Else 
    Begin 
      Result := Result + '..\' + sFile; 
    End; 
    sl.Free; 
  End; 
End; 

{===================================================} 
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) - 1) = 0 Then 
    Begin 
      Result:= FileName; 
    End 
    Else 
    Begin 
      Result:= StrPas (aTmp); 
    End; 
  End; 
End; 

{==============================================} 
Function LongFileName(ShortName: String): String; 
{==============================================} 
Var 
  SR: TSearchRec; 

Begin 
  Result := ''; 
  If (pos ('\\', ShortName) + pos ('*', ShortName) + 
      pos ('?', ShortName) <> 0) Or Not FileExists(ShortName) Then 
  Begin 
    { ignore NetBIOS name, joker chars and invalid file names } 
    Exit; 
  End; 
  While FindFirst(ShortName, faAnyFile, SR) = 0 Do 
  Begin 
    { next part as prefix } 
    Result := '\' + SR.Name + Result; 
    SysUtils.FindClose(SR);  { the SysUtils, not the WinProcs procedure! } 
    { directory up (cut before '\') } 
    ShortName := ExtractFileDir (ShortName); 
    If length (ShortName) <= 2 Then 
    Begin 
      Break;  { ShortName contains drive letter followed by ':' } 
    End; 
  End; 
  Result := ExtractFileDrive (ShortName) + Result; 
end;

--------------------

Испытание чужого терпения можно считать успешным, если оно лопнуло...

Felan

Дата 17.6.2008, 08:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 284
Регистрация: 2.8.2007
Где: Самара

Репутация: 2
Всего: 7

MinimizeName Routine в FileCtrl.

--------------------

// Любая сложная система - это темный лес. Каждый в этом лесу протаптывает свои тропинки, по ним и бегает. Лишь изредка, сходя с них, мы находим много интересного, а порою и страшного.

pseud

Дата 17.6.2008, 09:48 (ссылка)

(нет голосов)

Загрузка ...

Экспёрт Тыдыщ

Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40

Felan, +1

есть такая штука.
только длина там = не количество_символов, а количество пикселей.

пример кода:

Код


uses
  FileCtrl;

...

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  s := ParamStr(0);
  ShowMessage(s + #13#10 +
              MinimizeName(s, Canvas, 300) + #13#10 +
              MinimizeName(s, Canvas, 200) + #13#10 +
              MinimizeName(s, Canvas, 100) + #13#10 +
              MinimizeName(s, Canvas, 50));
end;

результат работы:

Цитата

---------------------------
Project1
---------------------------
C:\Program Files\Borland\Delphi6\Projects\Project1.exe
C:\Program Files\Borland\Delphi6\Projects\Project1.exe
C:\...\Delphi6\Projects\Project1.exe
C:\...\Project1.exe
Project1.exe
---------------------------
OK
---------------------------

--------------------

Испытание чужого терпения можно считать успешным, если оно лопнуло...

Felan

Дата 17.6.2008, 13:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 284
Регистрация: 2.8.2007
Где: Самара

Репутация: 2
Всего: 7

Цитата(pseud @ 17.6.2008, 11:48

)

есть такая штука.
только длина там = не количество_символов, а количество пикселей.

Ну и что?
Свойство Width никто не отменял вроде smile

--------------------

Matematik

Дата 19.6.2008, 12:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

Felan, Спасибо

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »