Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > имена в файлов ListBox а сам тех в Memo

Автор: Dryg 21.12.2009, 21:28

Проблема такая есть код он выдает все найденые файлы из папки MYFILE и включая все подкаталоги в ListBox!!

Код


procedure FindFiles(StartFolder, Mask: string; List: TStrings;
  ScanSubFolders: Boolean = True);
var
  SearchRec: TSearchRec;
  FindResult: Integer;
begin
  List.BeginUpdate;
  try
    StartFolder := IncludeTrailingBackslash(StartFolder);
    FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
    try
      while FindResult = 0 do
        with SearchRec do
        begin
          if (Attr and faDirectory) <> 0 then
          begin
            if ScanSubFolders and (Name <> '.') and (Name <> '..') then
              FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);
          end
          else
          begin
            if MatchesMask(Name, Mask) then
            begin
              List.Add(StartFolder +Name);
            end;

          end;
          FindResult := FindNext(SearchRec);
        end;
    finally
      FindClose(SearchRec);
    end;
  finally
    List.EndUpdate;
  end;
end;


применяется вот так

procedure TForm1.Button1Click(Sender: TObject);
begin
FindFiles('C:\MYFILE', '*.*',ListBox1.Items, true);
end;

смысол такой что граница ListBox у меня ограничено и получается что я не вижу имя фалы а только путь до него!!

пытался сделать так убрать StartFolder

Код


.......
begin
              List.Add(Name);
            end;
........

вот тогда появляются только имя фала это в принцапе мне так и нужно!! но по двойному щелчку по ListBox точнее по имени файла выдает ошибку что файл не найден, а мне нужно что бы он открывался в Memo поле!
выгружаю вот так в Memo

Код


procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.LoadFromFile(PChar(ListBox1.Items[ListBox1.ItemIndex]));
end;

подскажите как сделать правильно!!

Автор: kami 22.12.2009, 00:00

Имхо, проще всего завести второй список (TStringList), в котором хранить полные имена файлов. В ListBox загружать только имя, без пути. И по двойному клику на элементе обращаться не к ListBox1.Items[i], а к этому TStringList...

Добавлено через 5 минут и 36 секунд
Поясняю.

Код


type
  TForm1=class....
  .......
  private
    FFullNames:TStringList;
  ........
  end;

implementation

procedure FindFiles(StartFolder, Mask: string; List, FullNames: TStrings; ScanSubFolders: Boolean = True);
begin
 ....
            if MatchesMask(Name, Mask) then
            begin
              FullNames.Add(StartFolder +Name);
              List.Add(Name);
            end;
...
end;

procedure TForm1.FormCreate(...);
begin
  FFullNames:=TStringList.Create;
end;

procedure TForm1.FromDestroy(...);
begin
  FFullNames.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines.LoadFromFile(FFullNames[ListBox1.ItemIndex]);
end;

Добавлено через 6 минут и 29 секунд
Ну и вызов, соответственно

Код


procedure TForm1.Button1Click(Sender: TObject);
begin
  FindFiles('C:\MYFILE', '*.*',ListBox1.Items, FFullNames, true);
end;

Автор: Данкинг 22.12.2009, 00:09

Грузи не в ListBox, а в Memo: у него скроллбары есть. smile

Код


FindFiles('C:\MYFILE', '*.*',memo1.Lines, true);

Автор: aidaid 3.1.2010, 17:32

Может сделать так

Код


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);

begin
    with ListBox1, Canvas do
    begin
          if odFocused in State then
          begin
                Brush.Color := clBlue;
                Font.Color  := clWhite;
          end
          else
          begin
                Brush.Color := clWhite;
                Font.Color  := clBlack;
          end;
          FillRect(Rect);
          TextOut(Rect.Left + 2, Rect.Top + 0, ExtractFileName(Items[Index]));
   end;
end;

Автор: ферзь 4.1.2010, 00:30

aidaid Умное решение данной проблемы так как не придётся использовать ни чего лишнего! Никаких Листбоксов, Массивов и Мемо! smile