Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.12.05;
Скачать: CL | DM;

Вниз

файловая система и TREEVIEW   Найти похожие ветки 

 
main   (2004-11-23 11:54) [0]

Спасибо всем за помощь.
Вот что получилось
(*
ПРОГРАММА ПРЕДНАЗНАЧЕНА ДЛЯ ВЫВОДА РЕЗУЛЬТАТОВ ПОИСКА ФАЙЛОВ
В ВИДЕ ДЕРЕВА, А ТАКЖЕ ДЛЯ ВЫВОДА ПОЛНОГО ИМЕНИ ФАЙЛА(УЧИТЫВАЯ
КАТАЛОГИ)
*)

unit Uscandir;

interface

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

type
 TForm1 = class(TForm)
   TreeView1: TTreeView;// ДЕРЕВО КАТАЛОГОВ И ФАЙЛОВ
   BitBtn1: TBitBtn;    //НАЖАТИЕ КНОПКИ ПРИВОДИТ К НАЧАЛУ ПОИСКА
   Label1: TLabel;      // ВЫВОДИМ ИМЯ НАЙДЕННОГО ФАЙЛА ВО ВРЕМЯ ПОИСКА
   Label2: TLabel;      //ВЫВОДИМ ПОЛНОЕ ИМЯ ФАЙЛА ПРИ ВЫДЕЛЕНИИ ЕГО В ДЕРЕВЕ
   procedure BitBtn1Click(Sender: TObject); //ИЩЕМ ФАЙЛЫ
   procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
   //ВЫВОДИМ ПОЛНОЕ ИМЯ ФАЙЛА
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
(* ИЩЕМ ФАЙЛЫ С ЗАДАННЫМ РАСШИРЕНИЕМ В УКАЗАННОМ КАТАЛОГЕ*)
procedure TForm1.BitBtn1Click(Sender: TObject);
var
 CachedStrs: TStringList;
 Procedure AddItem(Lev: Integer; ParentNode: TTreeNode; S: String);
   Function FindNodeWithText(AParent: TTreeNode; Const S: String): TTreeNode;
   Var
     K : Integer;
     fStr : String;
     tmpNode: TTreeNode;
   Begin
   Result := Nil;
   fStr := S + IntToStr(Integer(AParent));
   K := CachedStrs.IndexOf(fStr);
   If K > -1 Then
     Result := Pointer(CachedStrs.Objects[K])
   Else
     Begin
     If AParent <> Nil Then
     tmpNode := AParent.getFirstChild
     else
     tmpNode := TreeView1.Items.GetFirstNode;
     While tmpNode <> Nil Do
       Begin
       If tmpNode.Text = S Then
         Begin
         Result := tmpNode;
         CachedStrs.AddObject(fStr, Pointer(tmpNode));
         break;
         End;
       tmpNode := tmpNode.getNextSibling;
       End;
      End
    End;

 Var
   prefix: String;
   ID : Integer;
   aNode : TTreeNode;
 Begin
 If S = "" Then Exit;
 ID := Pos("\", S);
 prefix := "";
 If ID > 0 Then
 prefix := Copy(S, 1, ID - 1)
 Else
   Begin
   prefix := S;
   S := "";
   End;
 aNode := FindNodeWithText(ParentNode, prefix);
 If aNode = Nil Then
   Begin
   aNode := TreeView1.Items.AddChild(ParentNode, prefix);
   label1.Caption:="Найден файл "+anode.Text;
   repaint;
   End;
 AddItem(Lev + 1, aNode, Copy(S, ID + 1, Length(S)));
 End;

procedure ScanDir(StartDir: string;
                 Mask:     string;
                 treeview1:ttreeview);
var
 SearchRec : TSearchRec;
begin
if Mask = "" then Mask := "*.*";
if StartDir[Length(StartDir)] <> "\"
then  StartDir := StartDir + "\";
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
 begin
   repeat
   application.ProcessMessages;
   if (SearchRec.Attr and faDirectory) <> faDirectory then
   Additem(0,nil,startdir+searchrec.name);
   until FindNext(SearchRec) <> 0;
   FindClose(SearchRec);
  end;

if FindFirst(StartDir+"*.*", fadirectory, SearchRec) = 0 then
 begin
   repeat
   application.ProcessMessages;
     if (SearchRec.Name <> "..") and (SearchRec.Name <> ".")
     then
       begin
       ScanDir(StartDir + SearchRec.Name + "\",Mask,treeview1);
       end;
   until FindNext(SearchRec) <> 0;
   FindClose(SearchRec);
  end;

end;

(*ОСНОВНАЯ ПРОЦЕДУРА*)
begin
CachedStrs := TStringList.Create;
CachedStrs.Duplicates := dupIgnore;
CachedStrs.Sorted := True;
 Try
 TreeView1.Items.BeginUpdate;
 TreeView1.SortType := stNone;
 scandir("d:\novikova","*.txt",treeview1);
 finally
 TreeView1.Items.EndUpdate;
 CachedStrs.Free;
end;

end;

// ВЫВОДИМ ИМЯ ФАЙЛА С УЧЕТОМ КАТАЛОГА
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
 st:string;
 lev,i:integer;
begin
st:=node.Text;
label2.Caption:=st;
repaint;
lev:=node.Level;
if lev<>0 then
 for i:=1 to lev do
 begin
 st:=node.Parent.Text+"\"+st;
 label2.Caption:=st;
 node:=node.Parent;
 end;

end;

end.
Вопрос
Нужно сделать из этого компоненту. Помогите, кто может...


 
Ozone ©   (2004-11-23 12:43) [1]

Тебе сюда - http://www.delphimaster.ru/cgi-bin/forum.pl?n=12


 
main   (2004-11-23 12:58) [2]

Спасибо...



Страницы: 1 вся ветка

Текущий архив: 2004.12.05;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.039 c
8-1094274897
Nomolos
2004-09-04 09:14
2004.12.05
MCI-окна


14-1100708745
Димитрий
2004-11-17 19:25
2004.12.05
Лавров высказался за продажу Курильских островов


4-1098281613
UnDISCOvery
2004-10-20 18:13
2004.12.05
Не могу связать 2 компа через COM-порт. Помогите!


1-1100702009
AlexxGold
2004-11-17 17:33
2004.12.05
Перевод ресурсов делфи


14-1100750611
alienserg
2004-11-18 07:03
2004.12.05
помогите потестировать мессенджер...