Добрый день Мастера Delphi!

Не могу понять почему не работает задуманно процедура, которая выводит в CheckListBox1 список файлов и одновременно удаляет из адреса (полного пути к файлам) путь и имя указанной папки. Например:

путь и имя указанной папки: E:\Копия !!!\
список файлов до процедуры: E:\Копия !!!\1\Точечный рисунок1.bmp
надо чтобы было в списке: 1\Точечный рисунок1.bmp

вот код который я использую:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   btn1: TButton;
   CheckListBox1: TCheckListBox;
   btn2: TButton;
   procedure btn1Click(Sender: TObject);
   procedure btn2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

var i,j:Integer;

procedure SpisokSokrat;//сократить список до неполных адресов
var cou:integer;
s:string;
begin
cou:=Length('E:\Копия !!!\');

Unit1.Form1.CheckListBox1.Items.BeginUpdate;
for i:=Unit1.Form1.CheckListBox1.Count-1 downto 0 do begin
   j:=Unit1.Form1.CheckListBox1.Items.IndexOf(Unit1.Form1.CheckListBox1.Items[i]);
   if j>=0 then begin Application.ProcessMessages;

s:= Unit1.Form1.CheckListBox1.Items.Strings[i];
Delete(s,1,cou);
Unit1.Form1.CheckListBox1.Items.Strings[i]:=s;

end;//if j>=0 then begin Application.ProcessMessages;
end;//for i:=CheckListBox1.Count-1 downto 0 do begin

Unit1.Form1.CheckListBox1.Items.EndUpdate;

end;//конец/////////////////////////////////////////////////////////////////////

//получение списка всех файлов включая полный адрес
procedure ListFilesInDirectory(Dir: string; Strings: TStrings);
var
 rSearchRec: TSearchRec;
begin
 if ((Dir = '') or (not Assigned(Strings))) then
   Exit;
 Dir := IncludeTrailingPathDelimiter(Dir);
 if FindFirst(Dir + '\*.*', faAnyFile, rSearchRec) = 0 then
   try
     repeat
       if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
         if (rSearchRec.Attr and faDirectory) <> 0 then begin
           Application.ProcessMessages;
           ListFilesInDirectory(Dir+rSearchRec.Name, Strings);
           end
           else begin
           Application.ProcessMessages;
           Strings.Add(Dir+rSearchRec.Name);
           end;
     until FindNext(rSearchRec) <> 0;
   finally
     FindClose(rSearchRec);
   end;
end;//конец/////////////////////////////////////////////////////////////////////

//получение списка всех файлов с сокращенным адресом
procedure ListFilesInDirectoryMenus(Dir: string; Strings: TStrings);
var
 rSearchRec: TSearchRec;
 cou:Integer;
 s:string;
begin
 if ((Dir = '') or (not Assigned(Strings))) then
   Exit;
 Dir := IncludeTrailingPathDelimiter(Dir);
 if FindFirst(Dir + '\*.*', faAnyFile, rSearchRec) = 0 then
   try
     repeat
       if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
         if (rSearchRec.Attr and faDirectory) <> 0 then begin
           Application.ProcessMessages;
           ListFilesInDirectory(Dir+rSearchRec.Name, Strings);
           end
           else begin
           Application.ProcessMessages;
           cou:=Length(Dir+'\');
           s:=(Dir+rSearchRec.Name);
           Delete(s,1,cou);
           Strings.Add(s);
           end;
     until FindNext(rSearchRec) <> 0;
   finally
     FindClose(rSearchRec);
   end;
end;//конец/////////////////////////////////////////////////////////////////////

procedure TForm1.btn1Click(Sender: TObject);//работает
begin
ListFilesInDirectory('E:\Копия !!!\', CheckListBox1.Items);
SpisokSokrat;//сокращает список до неполных адресов
end;

procedure TForm1.btn2Click(Sender: TObject);//не работает
begin
ListFilesInDirectoryMenus('E:\Копия !!!\', CheckListBox1.Items)
end;

end.

Моя объедененная процедура ListFilesInDirectoryMenus почему-то выводит список с полными адресами, а не с сокращенными. И даже переменная cou почему-то не считается (я выводил ее в список вместе с переменной s).

Может кто знает почему не работает ListFilesInDirectoryMenus ?

Буду благодарен за помощь или подсказку. Заранее спасибо!

Сделайте код как ConsoleApp. Так проверить сложно.
Научитесь пользоваться пошаговой отладкой (F7, F8) и смотрите что происходит в переменных.

-> 'E:\Копия !!!\' <- Пользуйтесь константами. Набивая в нескольких местах одно и то же можно ошибиться.

> Моя объедененная процедура ListFilesInDirectoryMenus почему-
> то выводит список с полными адресами


на первый взгляд:


> procedure TForm1.btn2Click(Sender: TObject);//не работает
> begin
> ListFilesInDirectoryMenus('E:\Копия !!!\', CheckListBox1.
> Items)
> end;



> procedure ListFilesInDirectoryMenus(Dir: string; Strings:
>  TStrings);
> ...
> s:=(Dir+rSearchRec.Name);
> Strings.Add(s); \\ может таки Strings.Add(rSearchRec.Name) ???


Пардон, если глупость пишу, глянула текст и бросилось в глаза

Вижу, где ошиблась. Еще раз пардон.

> Dir := IncludeTrailingPathDelimiter(Dir);
>  if FindFirst(Dir + '\*.*', faAnyFile, rSearchRec) = 0 then

И нафига дважды добавлять слэш?

>            cou:=Length(Dir+'\');
>            s:=(Dir+rSearchRec.Name);
>            Delete(s,1,cou);


тоже непонятно зачем

> Unit1.Form1.CheckListBox1.Items.BeginUpdate;

дальше читать не стал.

При нажатии кнопки btn1 сначала добавляютя в CheckListBox1 файлы с полным адресом (с помощью процедурыListFilesInDirectory), а потом все записи в CheckListBox1 с помощью процедуры SpisokSokrat сокращаются (выводятся без указанной папки) --- и все это работает как надо (даже с заменой пути к папке на переменную с путем к папке).

А вот при нажатии кнопки btn2 используется объедененная процедура ListFilesInDirectoryMenus (выполняющая тоже самое что и при нажатиии на btn1) --- и это не работает как надо (а надо что-бы за один заход выполнялось то, что выполняется при нажатии кнопки btn1 - это должно экономить время т.к. объем запесей велик).

если работает


> //получение списка всех файлов включая полный адрес
> procedure ListFilesInDirectory(Dir: string; Strings: TStrings);
>


замени в ней
     Strings.Add(Dir+rSearchRec.Name);
на
     Strings.Add(rSearchRec.Name);

и будет тебе счастье
наверное

еще интереснее аля так

type
TListBox = class(StdCtrls.TListBox)
public
  FCutThisOnAdd: string;
  procedure SuperAdd(S: string);
end;
.......
procedure TListBox.SuperAdd(S: string);
begin
 stringreplace(s, FCutThisOnAdd,'',[rfReplaceAll])
 Items.Add(s);
end;

или даже перекрыть Add, а не писать SuperAdd
т.е. заданный шаблон FCutThisOnAdd автоматом отрезается при добавлении, в т.ч. из середины/конца и т.п.
А если не задан - то обычное добавление будет

> SuperAdd
на все 100 )

repeat
      if ((rSearchRec.Name = '.') or (rSearchRec.Name = '..')) then
???
        Continue;
      if (rSearchRec.Attr and faDirectory) <> 0 then
      begin
        Application.ProcessMessages;
        ListFilesInDirectory(Dir + rSearchRec.Name, LB);
      end
      else
      begin
        Application.ProcessMessages;

> if ((rSearchRec.Name = '.') or (rSearchRec.Name = '..'))
> then
> ???
>         Continue;

не нравится отступать в коде

if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if
эквивалентно
if ((rSearchRec.Name = '.') or (rSearchRec.Name = '..')) then
  продолжить со следующим i
и далее с таким же отступом можно писать, не отступая вправо еще раз
Даешь только левые идеи!))))))))))

>> Application.ProcessMessages;
надоело причесывать, копипастнул тупо )

> > then
> > ???
> >         Continue;
не нравится отступать в коде

дело не в отступе.


> надоело причесывать, копипастнул тупо )

тупое копипасте не может породить нетупое )