VPF::сокращение пути - Форум программистов

z-END

Дата 19.1.2005, 14:21 (ссылка)

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

Загрузка ...

прафесар™

Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 11
Всего: 102

как бы мне в Label вывести путь к файлу в таком виде: "C:\F1\...\new.txt", если путь оказывается длиннее чем можно показать в Label.
В DRKB нашел код который позволяет рисовать так на канаве, а мине эт не подходит. надо именно получить текст.

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

Каждый чилавек пасвоему праф...а памоему НЕТ!

Rennigth

Дата 19.1.2005, 14:24 (ссылка)

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

Загрузка ...

Эксперт

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

Репутация: 49
Всего: 76

делал, давно правда функцию обрезания по длине(тож самое в TLabel нужно было выводить), сейчас поищу - мож найду

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

(* Honesta mors turpi vita potior *)

Akella

Дата 19.1.2005, 15:21 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

во первых отключи в метке авторазмер, далее берем первые несколько символов и последние несколько символов. Соединяем через троеточие. Может позже дам пример. Жди

z-END

Дата 19.1.2005, 15:26 (ссылка)

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

Загрузка ...

прафесар™

Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 11
Всего: 102

dsergey жду=)

Цитата(dsergey @ 19.1.2005, 15:21)

берем первые несколько символов и последние несколько символов

тока мне не "несколько" надо, а так чтобы затроеточивалсь smile

столько сколько не влазит (в пределах папки) в лабел, ну а про AutoSize знают все=)

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

Каждый чилавек пасвоему праф...а памоему НЕТ!

Rennigth

Дата 19.1.2005, 15:39 (ссылка)

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

Загрузка ...

Эксперт

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

Репутация: 49
Всего: 76

z-END
уже нашел, сейчас малек подправлю, а то в таком виде стыдно выкладывать smile

... давно было... , но работает нормально, я когда делал блал за основу как сокращают пути всякие копировальщики и тд.

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

(* Honesta mors turpi vita potior *)

z-END

Дата 19.1.2005, 15:41 (ссылка)

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

Загрузка ...

прафесар™

Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 11
Всего: 102

Rennigth не стесняйся все свои smile

выкладывай как есть !

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

Каждый чилавек пасвоему праф...а памоему НЕТ!

Snowy

Дата 19.1.2005, 15:58 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Код


procedure PlaceText(s:string; L:TLabel);
var
  i: integer; //позиция, куда ставить точки
  dots: integer; // ширина, которую точки займет на лабеле
begin
  if L.Canvas.TextWidth(s)>L.Width then //если не влазит
  begin
    i:=LastDelimiter('\', s);
    dots:=L.Canvas.TextWidth('...');
    while L.Canvas.TextWidth(s)+dots>L.Width do //вырезаем по символу, пока не влезет
    begin
      if i>0 then dec(i);
      delete(s,i,1);
    end;
    if i>0 then insert('...',s,i); //вставляем точки
  end;
  L.Caption:=s;
end;

Это сообщение отредактировал(а) Snowy - 19.1.2005, 16:02

Akella

Дата 19.1.2005, 16:06 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Snowy, получается "...\DriverFiles" из "C:\WINDOWS\system32\ReinstallBackups\0002\DriverFiles", а нужно

Цитата

"C:\F1\...\new.txt",

Snowy

Дата 19.1.2005, 16:10 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

А ты пробовал до того, как я исправил или уже после?
После того, как поправил, это учитывается.
У меня все корректно выдало: C:\WIND...\DriverFiles
Добавлено @ 16:15
Еще раз поправочка:

Код


procedure PlaceText(s:string; L:TLabel);
var
  i: integer; //позиция, куда ставить точки
  dots: integer; // ширина, которую точки займет на лабеле
begin
  if L.Canvas.TextWidth(s)>L.Width then //если не влазит
  begin
    i:=LastDelimiter('\', s);
    dots:=L.Canvas.TextWidth('...');
    while L.Canvas.TextWidth(s)+dots>L.Width do //вырезаем по символу, пока не влезет
    begin
      if i>1 then dec(i) else i:=1;
      delete(s,i,1);
    end;
    if i>1 then insert('...',s,i); //вставляем точки
  end;
  L.Caption:=s;
end;

Прошлый вариант зацикливался, если лабел очень маленький.
Кстати, варнинг! Размер лабела не должен быть меньше '...' + хотя бы одна буква!

z-END

Дата 19.1.2005, 16:15 (ссылка)

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

Загрузка ...

прафесар™

Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 11
Всего: 102

Цитата(Snowy @ 19.1.2005, 16:10)

\WIND...\

вот этого как раз и недолжно быть
или \WINDOWS\ пишется целиком или не пишется вообще.

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

Каждый чилавек пасвоему праф...а памоему НЕТ!

Akella

Дата 19.1.2005, 16:25 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

вот, держи, все получилось

Код


Edit1.Text := 'C:\WINDOWS\system32\ReinstallBackups\0002\DriverFiles';

Function PosExt(SubStr,Str:String;P:integer):Integer;
Var
 i,p1:integer;
begin
  p1:=0;
  result:=-1;
  For i:=1 to Length(Str) do begin
    if SubStr = Str[i] then begin
      Inc(p1);
      if p = p1 then begin
        result := i;
        exit;
      end;//if
    end;
  end;//for
end;

Function PosCount(SubStr,Str:String):Integer;
Var
 i:integer;
begin
  result:=0;
  For i:=1 to Length(Str) do begin
    if SubStr = Str[i] then begin
      Inc(result);
    end;
  end;//for
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
 s,s1:string;
 f,c,l:integer;
begin
//Ищем 2-й симол - разделитель пути, есть в SysUtils константа PathDelim
  f:=PosExt(PathDelim,Edit1.Text,2);
//узнаем общее количество разделителей
  c:=PosCount(PathDelim,Edit1.Text);
//Ищем последний по счету символ - разделитель пути
  l:=PosExt(PathDelim,Edit1.Text,c);
//теперь все соединяем
  label1.Caption:=Copy(Edit1.Text,1,f)+'...'+Copy(Edit1.Text,l,Length(Edit1.Text)-c);
end;

Это сообщение отредактировал(а) dsergey - 19.1.2005, 16:25

Snowy

Дата 19.1.2005, 16:31 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Ну тогда дополняем:

Код


procedure PlaceText(s:string; L:TLabel);
var
  i: integer; //позиция, куда ставить точки
  dots: integer; // ширина, которую точки займет на лабеле
begin
  if L.Canvas.TextWidth(s)>L.Width then //если не влазит
  begin
    i:=LastDelimiter('\', s);
    dots:=L.Canvas.TextWidth('...');
    while L.Canvas.TextWidth(s)+dots>L.Width do //вырезаем по символу, пока не влезет
    begin
      if i>1 then dec(i) else i:=1;
      delete(s,i,1);
    end;
    while (i>1) do begin
      if s[i-1]='\' then break;
      if i>1 then dec(i) else i:=1;
      delete(s,i,1);
    end;
    if i>1 then insert('...',s,i); //вставляем точки
  end;
  L.Caption:=s;
end;

Теперь выдает: C:\WINDOWS\...\DriverFiles
Так нормально?

Это сообщение отредактировал(а) Snowy - 19.1.2005, 16:33

z-END

Дата 19.1.2005, 16:33 (ссылка)

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

Загрузка ...

прафесар™

Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 11
Всего: 102

dsergey ты не пробывал Edit1.Text:='C:\' ? забавно получается =)
И самое, главное онное всегда урезает путь, причем до минимума: первая папка и последняя вложенная.
А надо:

Цитата(z @ 19.1.2005, 15:26)

надо, а так чтобы затроеточивалсь столько сколько не влазит (в пределах папки) в лабел

и не больше.

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

Каждый чилавек пасвоему праф...а памоему НЕТ!

Akella

Дата 19.1.2005, 16:35 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Snowy, ты тестировал сой код или пишеш навскидку? smile

Snowy

Дата 19.1.2005, 16:39 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Что опять не так?

Код


procedure TForm1.Button1Click(Sender: TObject);
begin
  PlaceText('E:\Program Files\WinRAR\Rar.exe',Label1);
end;

Прекрасно отрабатывает. Что у тебя не работает? Говори, посмотрим.

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