Beranda > Delphi > Shortening the pathname with an ellipses (…)

Shortening the pathname with an ellipses (…)

I found this function somewhere that I find very useful sometimes.  Pass a long pathname to the function and a handle to the control the path is to be viewed in and it will return the shortened version with an ellipses (…).  The control’s handle is used to determine the width needed for the pathname and will work on any size the system’s font settings are set to. For example, put a TPanel on a form, call the function like this: Panel1.Caption := MinimizePathName(Panel1.Handle, ‘C:\This Directory\This Subdirectory\Another\ThisFile.txt’); and what you will see is ‘C:\…\Another\ThisFile.txt’.function MinimizePathName(Wnd: HWND; const Filename: string): string;
{ func to shorten the long path name with an ellipses ‘…’ to fit }
{ in whatever control is passed to the Wnd parameter.              }
{ Usage: Panel1.Caption := MinimizePathName(Panel1.Handle, DirectoryOutline1.Directory) }
{        This will shorten the path if necessary to fit in Panel1.                      }
  procedure CutFirstDirectory(var S: string);
  var
    Root: Boolean;
    P: Integer;
  begin
    if S = ‘\’ then
      S := ”
    else
      begin
        if S[1] = ‘\’ then
          begin
            Root := True;
            Delete(S, 1, 1);
          end
        else
          Root := False;
        if S[1] = ‘.’ then
          Delete(S, 1, 4);
        P := Pos(‘\’,S);
        if P <> 0 then
          begin
            Delete(S, 1, P);
            S := ‘…\’ + S;
          end
        else
          S := ”;
        if Root then
          S := ‘\’ + S;
      end;
  end;

  function GetTextWidth(DC: HDC; const Text: string): Integer;
  var
    Extent: TSize;
  begin
    if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then
      Result := Extent.cX
    else
      Result := 0;
  end;

var
  Drive,
  Dir,
  Name: string;
  R: TRect;
  DC: HDC;
  MaxLen: integer;
  OldFont, Font: HFONT;
begin
  Result := FileName;

  if Wnd = 0 then
    Exit;

  DC := GetDC(Wnd);
  if DC = 0 then
    Exit;

  Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
  OldFont := SelectObject(DC, Font);
  try
    GetWindowRect(Wnd, R);
    MaxLen := R.Right – R.Left;

    Dir := ExtractFilePath(Result);
    Name := ExtractFileName(Result);

    if (Length(Dir) >= 2) and (Dir[2] = ‘:’) then
      begin
        Drive := Copy(Dir, 1, 2);
        Delete(Dir, 1, 2);
      end
    else
      Drive := ”;

    while ((Dir <> ”) or (Drive <> ”)) and (GetTextWidth(DC, Result) > MaxLen) do
      begin
        if Dir = ‘\…\’ then
          begin
            Drive := ”;
            Dir := ‘…\’;
          end
        else
          if Dir = ” then
            Drive := ”
          else
            CutFirstDirectory(Dir);
        Result := Drive + Dir + Name;
      end;
  finally
    SelectObject(DC, OldFont);
    ReleaseDC(Wnd, DC);
  end;
end;

Iklan
Kategori:Delphi
  1. Belum ada komentar.
  1. No trackbacks yet.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: