• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 361
  • Last Modified:

Compact File Path String

I have a ListBox that contains a list of file paths. In the OnDrawItem event I need to show as much of the path string as possible given the width of the ListBox.

For example, I need to convert:

C:\Program Files\Borland\Delphi5\Demos

to something like

C:\... \Borland\Delphi5\Demos

if that's all that will fit in the ListBox width.

Can someone provide a standalone function to do this? (Meaning that I don't want to have to use the FileCtrl or ShellAPI units).


Thanks
0
Grieg
Asked:
Grieg
  • 3
  • 2
  • 2
  • +3
1 Solution
 
nestoruaCommented:
HI,
If I understood you correctly, you don't know how to count
the length of a string with 6 symbols from the first and
the last (from the right) suitable backslash ?
Am I right?
Sincerely,
Nestorua.
0
 
GriegAuthor Commented:
Sorry if I wasn't clear enough. What I'm looking for is a "smart" function that will preserve as much of the original filepath as possible, given the available width of the ListBox (and the TextWidth). As another case would illustrate:

C:\Program Files\Macromedia Flash\Flash5

might be converted to

C:\Program Files\... \Flash5

So, the first "folder" from the left is not necessarily the one being reduced to a "\... \"


I hope that makes sense. :)





0
 
nestoruaCommented:
OK,
Then what are you called the "smart" function?
What criteria you want to use to be able to choose the appropriate string?
Sincerely,
Nestorua.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
shaneholmesCommented:
OFF THE TOP OF MY HEAD, I would try something like this, or a variation of this in like the OnChange event of the TComboBox.  Text controls are capable of this behavior using the constant DT_PATH_ELLIPSIS.


var
  B : array[0..255] of Char;
  R : TRect;


  StrCopy(B,ComboBox1.Text);
  R := ComboBox1.ClientRect;
  InflateRect(R,-10,-10);
  DrawTextEx(ListBox1.Canvas.Handle,B,-1,R,
    DT_PATH_ELLIPSIS or DT_MODIFYSTRING or DT_CALCRECT, nil);
  ComboBox1.Text:= B;


Shane
0
 
alanwhincupCommented:
Just set your ListBoxs Style property to either lbOwnerDrawFixed or lbOwnerDrawVariable as appropriate then use the below code:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  S : string;
begin
  if Index = -1 then
    Exit;
  with (Control as TListBox) do
  begin
    Canvas.FillRect(Rect);
    S := ' ' + Items[Index];
    DrawTextEx(Canvas.Handle, PChar(S), -1,
      Rect, DT_PATH_ELLIPSIS, nil);
  end;
end;

Cheers,

Alan
0
 
lottolCommented:
try this

{main.pas}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TMainForm = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    LoadBtn: TButton;
    Button1: TButton;
    procedure LoadBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function SearchWildCards(FindPath: TFileName; Attributes: integer): TStrings;
function TrimPath(Path: String; MaxLength: integer): string;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

function SearchWildcards(FindPath: TFileName; Attributes: integer): TStrings;
var
 StringList: TStringList;
 IsFound: Boolean;
 sr: TSearchRec;
 Path: TFileName;
begin
 Path := ExtractFilePath(FindPath);
 StringList := TStringList.Create;
 try
  IsFound := FindFirst(FindPath,Attributes,sr) = 0;
  while IsFound do
   begin
    StringList.Add(Path + sr.Name);
    IsFound := FindNext(sr) = 0;
   end;
  FindClose(sr);
 except
  StringList.Free;
  StringList := nil;
 end;
 Result := StringList;
end;

function TrimPath(Path: String; MaxLength: integer): string;
const
 PathDelimiters = ['/','\'];
 PathCutter = '..\';
var
 TmpStr     :string;
 Tokens     :TStringList;
 i,j        :integer;
 StartTk    :integer; // First cutting folder
 EndTk      :integer; // Last cutting folder
 MinCutLen  :integer;
 TmpCutLen  :integer;
 Len        :integer;
 Exceeds    :integer;
begin
// Fill Tokens
 Len := Length(Path);
 if Len <= MaxLength then
  begin
   Result := Path;
   exit;
  end;
 try
  Tokens := TStringList.create;
  StartTk := 1;
  for i := 1 to Len do
   if IsPathDelimiter(Path, i) then
    begin
     TmpStr := copy(Path, StartTk, i - StartTk + 1);
     Tokens.AddObject(TmpStr, Pointer(Length(TmpStr)));
     StartTk := i+1;
    end;
  if StartTk < Len then
    begin
     TmpStr := copy(Path, StartTk, Len);
     Tokens.AddObject(TmpStr, Pointer(Length(TmpStr)));
    end;
// Determine StartTk and EndTk
  MinCutLen := Len;
  Exceeds   := Len - MaxLength + Length(PathCutter);
  StartTk   := 0;
  EndTk     := Tokens.Count-1;
  for i := 1 to Tokens.Count-1 do // Always keep driver letter, else "for i := 1 to Tokens.Count-1 do"
   begin
    TmpCutLen := 0;
    for j := i to Tokens.Count-1 do
     begin
      TmpCutLen := TmpCutLen + integer(Tokens.Objects[j]);
      if (TmpCutLen >= Exceeds) then
       begin
        if TmpCutLen < MinCutLen then
         begin
          StartTk := i;
          EndTk   := j;
         end;
        break;
       end;
     end;
   end;
// Prepare cutted path
  TmpStr := '';
  for i := 0 to StartTk-1 do TmpStr := TmpStr + Tokens[i];
  TmpStr := TmpStr + PathCutter;
  for i := EndTk+1 to Tokens.Count-1 do TmpStr := TmpStr + Tokens[i];
 finally
  Tokens.Free;
 end;
 Result := TmpStr;
end;

procedure TMainForm.LoadBtnClick(Sender: TObject);
var
 Paths: TStrings;
 SysDir: array[1..255] of char;
begin
 try
  GetSystemDirectory(@SysDir,255);
  Paths := SearchWildCards(StrCat(@SysDir,'\*.*'), faDirectory);
  ListBox1.Items.Text := Paths.Text;
 finally
  Paths.free;
 end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
 ShowMessage(TrimPath(ListBox1.Items[ListBox1.ItemIndex],10));
end;

procedure TMainForm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
 S : string;
begin
 if Index = -1 then
   Exit;
 with (Control as TListBox) do
 begin
   Canvas.FillRect(Rect);
   S := TrimPath(ListBox1.Items[Index], Trunc(Rect.Right/ListBox1.Font.Size));
   DrawTextEx(Canvas.Handle, PChar(S), -1, Rect, DT_PATH_ELLIPSIS, nil);
 end;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
 ListBox1.Invalidate;
end;

end.

{main.dfm}

object MainForm: TMainForm
  Left = 488
  Top = 167
  Width = 380
  Height = 486
  Caption = 'MainForm'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 372
    Height = 432
    Align = alClient
    Font.Charset = RUSSIAN_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    Style = lbOwnerDrawFixed
    TabOrder = 0
    OnDrawItem = ListBox1DrawItem
  end
  object Panel1: TPanel
    Left = 0
    Top = 432
    Width = 372
    Height = 27
    Align = alBottom
    BevelOuter = bvNone
    TabOrder = 1
    object LoadBtn: TButton
      Left = 6
      Top = 2
      Width = 75
      Height = 25
      Caption = '&Load Paths'
      Default = True
      TabOrder = 0
      OnClick = LoadBtnClick
    end
    object Button1: TButton
      Left = 90
      Top = 2
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 1
      OnClick = Button1Click
    end
  end
end
0
 
orascriptCommented:
alanwhincup has already given **the** correct answer. Amazing how much wasted code/time is caused by ignorance of the win api
0
 
lottolCommented:
Really amazing is different thing. How orascript, you can see things, which others can't?
Where did you find function for COMPACTING OF THE FILE PATH in the alanwhincup's answer?
0
 
alanwhincupCommented:
0
 
lottolCommented:
Ok
The person, how don't see things, is I. :)
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 3
  • 2
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now