Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Короткий путь 
:(
    Опции темы
Alex
Дата 12.5.2004, 22:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Все знают, как из длинного пути получить короткий путь, но для отображения пользователю полученный короткий путь не годится, многие программы отображают короткий путь в виде "диск...\папка\файл". Вроде бы это уже обсуждался, но через поиск я не нашел. Как это сделать в теории я знаю, но может у кого-то есть готовое решение? Ну, если нет, то придется писать.


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
<Spawn>
Дата 13.5.2004, 05:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Око кары:)
****


Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64
Вот примерно так:

Код
function ExtractShortPath(const FilePath: string): string;
var
 intFrom, intTo, intCounter, intDelimCnt: integer;
 strTempPath: string;
begin
 Result := '';
 intDelimCnt := 0;

 for intCounter := 1 to Length(FilePath) do
   if AnsiCompareText(FilePath[intCounter], '\') = 0 then
     Inc(intDelimCnt);

 if intDelimCnt <= 2 then
 begin
   Result := FilePath;
   Exit;
 end;

 try
   strTempPath := FilePath;
   intTo := LastDelimiter('\', strTempPath);
   Delete(strTempPath, intTo, 1);
   intFrom := LastDelimiter('\', strTempPath);
 finally
   strTempPath := '';
 end;

 Result := Format('%s\..%s\%s',
                  [ExtractFileDrive(FilePath),
                   Copy(FilePath, intFrom, intTo - intFrom),
                   ExtractFileName(FilePath)]);
end;



--------------------
"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.
PM MAIL ICQ   Вверх
Alex
Дата 13.5.2004, 07:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Если бы все было так просто, я бы и вопрос не задал.
Я для примера сказал, что нужно получить "диск...\папка\файл". На самом деле количество отображаемых папок в пути должно зависеть от длины компонента для отображения результата. Сразу оговорюсь, что для отображения результата может использоваться заголовок формы.


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
<Spawn>
Дата 13.5.2004, 10:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Око кары:)
****


Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64
Ну дак что тебе мешает подгонять под компонет? Немножко переделать функцию, используя метод TCanvas - TextWidth или на прямую юзая GetTextExtentPoint32.


--------------------
"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.
PM MAIL ICQ   Вверх
<Spawn>
Дата 13.5.2004, 11:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Око кары:)
****


Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64
Вот, примерно похожим образом(хотя оптимальность кода еще не проверял - башка не работает, так что я спать пошел)) ):

Код
function ExtractFileShortPath(const FilePath: string;
 const MaxSize: Cardinal; const DC: HDC): string;
var
 intFrom, intTo, intCounter,
 intDelimCnt, intDelimCnt2, intTotalSize: integer;
 strTempPath, strDrive, strFileName,
 strDirs, strCurrentDir: string;
 Size: TSize;
begin
 Result := '';
 strTempPath := '';
 strDrive := '';
 strFileName := '';
 strDirs := '';
 strCurrentDir := '';

 intDelimCnt := 0;
 intDelimCnt2 := 0;
 intTotalSize := 0;

 for intCounter := 1 to Length(FilePath) do
   if AnsiCompareText(FilePath[intCounter], '\') = 0 then
     Inc(intDelimCnt);

 if intDelimCnt <= 2 then
 begin
   Result := FilePath;
   Exit;
 end;

 strTempPath := ExtractFilePath(FilePath);
 strDrive := ExtractFileDrive(FilePath);
 strFileName := ExtractFileName(FilePath);

 GetTextExtentPoint32(DC, PAnsiChar(strDrive), Length(strDrive), Size);
 Inc(intTotalSize, Size.cy);
 GetTextExtentPoint32(DC, PAnsiChar(strFileName), Length(strFileName), Size);
 Inc(intTotalSize, Size.cy);

 while (intTotalSize < MaxSize) and (intDelimCnt2 < intDelimCnt) do
 begin
   intTo := LastDelimiter('\', strTempPath);
   Delete(strTempPath, intTo, 1);
   intFrom := LastDelimiter('\', strTempPath);
   strCurrentDir := Copy(FilePath, intFrom, intTo - intFrom);
   GetTextExtentPoint32(DC, PAnsiChar(strCurrentDir), Length(strCurrentDir), Size);
   Inc(intTotalSize, Size.cy);
   Inc(intDelimCnt2)
 end;

 if intFrom = 0 then
   Result := FilePath
 else
   Result := Format('%s\..%s\%s',
                    [strDrive,
                     Copy(FilePath, intFrom, LastDelimiter('\', FilePath) - intFrom),
                     strFileName]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(ExtractFileShortPath(ParamStr(0), 35, Canvas.Handle));
end;


Кстати, после сна я ее модифицирую, если будет нужно и себе тож сохраню, недавно была такая проблема, но чего то функцию я не сделал smile.gif

Это сообщение отредактировал(а) <Spawn> - 13.5.2004, 11:33


--------------------
"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.
PM MAIL ICQ   Вверх
Akella
Дата 13.5.2004, 11:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


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

Репутация: 36
Всего: 329
Как вывести текст с красивым обрезанием если не помещается?

Используй вызов DrawTextEx, установив в параметре dwDTFormat значение DT_PATH_ELLIPSIS.
Код

procedure TForm1.FormPaint(Sender: TObject);
var
 r: TRect;
begin
 r := Rect(20, 20, 110, 70);
 // DT_PATH_ELLIPSIS or DT_WORD_ELLIPSIS or DT_END_ELLIPSIS
 DrawTextEx(Form1.Canvas.Handle, 'Delphi World - это круто!!!',
  25, r, DT_WORD_ELLIPSIS, nil);

может есть другие параметры у этой функции? Поэксперементируй.

это, кстати из DRKB (новый FAQ)

Это сообщение отредактировал(а) dsergey - 13.5.2004, 11:53
PM MAIL   Вверх
Alex
Дата 14.5.2004, 07:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Я не понял, куда ответы пропадают? sad.gif
Добавлено @ 07:54
<Spawn> Спасибо, я сегодня вечерком посмотрю, помойму она гдето глючит



--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Alex
Дата 15.5.2004, 13:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
И действительно функция работала совсем не корректно.
Вот исправленный код:
Код
function ExtractFileShortPath(const FilePath: string; const MaxSize: Integer; const DC: HDC): string;
var
 intFrom, intTo, intCounter,
 intDelimCnt, intDelimCnt2, intTotalSize: Integer;
 strTempPath, strDrive, strFileName,
 strCurrentDir: string;
 Size: TSize;
begin
 Result:=        '';
 strDrive:=      '';
 strTempPath:=   '';
 strFileName:=   '';
 strCurrentDir:= '';

 intTo:=        0;
 intFrom:=      0;
 intDelimCnt:=  0;
 intDelimCnt2:= 0;
 intTotalSize:= 0;

 for intCounter:= 1 to Length(FilePath) do
   if AnsiCompareText(FilePath[intCounter], '\') = 0 then
     Inc(intDelimCnt);

 if intDelimCnt <= 1 then begin
   Result:= FilePath;
   Exit;
 end;

 strDrive:=    ExtractFileDrive(FilePath);
 strTempPath:= ExtractFilePath (FilePath);
 strFileName:= ExtractFileName (FilePath);

 GetTextExtentPoint32(DC, PAnsiChar(strDrive), Length(strDrive), Size);
 Inc(intTotalSize, Size.cx);
 GetTextExtentPoint32(DC, PAnsiChar(strFileName), Length(strFileName), Size);
 Inc(intTotalSize, Size.cx);
 GetTextExtentPoint32(DC, '\..', 3, Size);
 Inc(intTotalSize, Size.cx);

 while (intTotalSize < MaxSize) and (intDelimCnt2 < intDelimCnt) do begin
   intTo:= LastDelimiter('\', strTempPath);
   Delete(strTempPath, intTo, 1);
   intFrom:= LastDelimiter('\', strTempPath);
   strCurrentDir := Copy(FilePath, intFrom, intTo - intFrom);
   GetTextExtentPoint32(DC, PAnsiChar(strCurrentDir), Length(strCurrentDir), Size);
   Inc(intTotalSize, Size.cx);
   Inc(intDelimCnt2);
 end;

 if intFrom = 0 then
   Result := FilePath
 else
   Result:= Format('%s\..%s\%s', [strDrive, Copy(FilePath, intTo, LastDelimiter('\', FilePath) - intTo), strFileName]);
end;



--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
<Spawn>
Дата 15.5.2004, 13:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Око кары:)
****


Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64
Ну главное я тебя натолкнул на мысль, а то что она не правильно работала и следовало ожидать - я в весь тот день себя плохо чувствовал, к вечеру давление так вскочило, что от каждого движения в голове отдовалось. Не знаю даже от чего такое было.


--------------------
"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.
PM MAIL ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0900 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.