Solved

Compact File Path String

Posted on 2002-04-18
10
341 Views
Last Modified: 2010-07-27
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
Comment
Question by:Grieg
  • 3
  • 2
  • 2
  • +3
10 Comments
 
LVL 4

Expert Comment

by:nestorua
ID: 6951798
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
 

Author Comment

by:Grieg
ID: 6951867
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
 
LVL 4

Expert Comment

by:nestorua
ID: 6951882
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
 
LVL 11

Expert Comment

by:shaneholmes
ID: 6952078
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
 
LVL 5

Accepted Solution

by:
alanwhincup earned 100 total points
ID: 6952217
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Expert Comment

by:lottol
ID: 6955784
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
 
LVL 3

Expert Comment

by:orascript
ID: 6955801
alanwhincup has already given **the** correct answer. Amazing how much wasted code/time is caused by ignorance of the win api
0
 

Expert Comment

by:lottol
ID: 6955857
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
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6956020
0
 

Expert Comment

by:lottol
ID: 6958797
Ok
The person, how don't see things, is I. :)
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now