| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

"..." в пути к файлу

BobbyDigital ©   (2005-10-26 18:05:00) 

Извините за часто задаваемый вопрос, но все же.
У меня на форме показыватся путь к открываемому файлу, вот и если путь оказывается слишком длинным как корректно поставить троеточие в пути.
Например:
C:\Program Files\Adobe\ ...\Utilities\ScriptListener.8li

---

Kolan   (2005-10-27 01:07:00) [1]

Вот несколько примеров: (На форме несколько кнопок и несколько едитов. Может что лишнее скинул)

procedure TForm1.BitBtn1Click(Sender: TObject);
var
 S, S1: string;
 Buffer: array[0..255] of Char;
begin
 S := Application.ExeName;
 S1 := '';
 GetShortPathName(PChar(S), Buffer, SizeOf(Buffer) - 1);
 S1 := StrPas(Buffer);
 Edit1.Text := S1;
 Edit2.Text := S;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);

var
P: PChar;
R: TRect;
S: string;
begin
S := Application.ExeName;
P := AllocMem(Length(S) + 1);
StrCopy(P, PChar(s));
//SetRect(R, 10, 10, 100, 25);
R := Edit3.ClientRect;
DrawText(Canvas.Handle, P, Length(s), R,
  DT_SINGLELINE or DT_CALCRECT or DT_LEFT or DT_MODIFYSTRING or DT_PATH_ELLIPSIS);
Edit3.Text := P;
FreeMem(P);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
 Edit4.Text := ExtractRelativePath(Application.ExeName, ExtractFileDir(ExtractFileDir(Application.ExeName)))
end;

function TForm1.GetDotShortFilePath(FilePath: string): string;
var
 DelimetersCount, SecondDelimeter: Integer;
 I: Integer;
begin
 DelimetersCount := 0;
 SecondDelimeter := 0;
 for I := 1 to Length(FilePath) do
 begin
   if FilePath[I] = '\' then
     DelimetersCount := DelimetersCount + 1;

   if (DelimetersCount = 2) and (SecondDelimeter = 0) then
     SecondDelimeter := I;

   if DelimetersCount >= 3 then
     Break;
 end;

 if DelimetersCount >= 3 then
 begin
   Result := Copy(FilePath, 1, SecondDelimeter) + '..\' + ExtractFileName(FilePath);
 end
 else
   Result := FilePath;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
 //Edit5.Text := GetDotShortFilePath(Application.ExeName);
 Edit5.Text := GetDotShortFilePath(Edit2.Text);
end;

function TForm1.AdjustStringToRect(S: string; Rect: TRect): string;
var                                
P: PChar;
begin
P := AllocMem(Length(S) + 1);
StrCopy(P, PChar(S));
Rect.BottomRight.X := Rect.BottomRight.X - 2;
DrawText(Canvas.Handle, P, Length(s), Rect,
  DT_SINGLELINE or DT_CALCRECT or DT_LEFT or DT_MODIFYSTRING or DT_PATH_ELLIPSIS);
Result := P;
FreeMem(P);
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
 Edit6.Text := AdjustStringToRect(Application.ExeName, Edit6.ClientRect);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 Edit6.Width := TrackBar1.Position;
 Edit6.Text := AdjustStringToRect(Application.ExeName, Edit6.ClientRect);
end;

---

bobbyDigital   (2005-10-27 00:55:00) [2]

Loginov Dmitry спасибо

---

bobbyDigital   (2005-10-27 00:55:00) [3]

Loginov Dmitry спасибо

---

MBo   (2005-10-26 18:41:00) [4]

DrawText c флагом DT_PATH_ELLIPSIS

---

Loginov Dmitry   (2005-10-26 18:24:00) [5]

Пример:

Label1.Caption := MinimizeName('С:\Program Files\AdobeUtilitiesScriptListener_2005_forAdmin\ScriptListener.8li', Label1.Canvas, 250)

---

Lexer   (2005-10-26 18:08:00) [6]

По какому принципу будешь ставить многоточие?
А что еcли этот путь выглядит:
С:\Program Files\AdobeUtilitiesScriptListener_2005_forAdmin\ScriptListener.8li

---

Наверх