Форум: "Основная";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];
Вниз
Псевдо проводник. Найти похожие ветки
← →
zt50 © (2005-01-03 23:22) [0]Допустим есть файл в котором лежат записи вида:
"COMMON\GRAPHICS\AVIS\FILECOPY.AVI
COMMON\GRAPHICS\AVIS\FILEDEL.AVI
COMMON\GRAPHICS\AVIS\FILEDELR.AVI
COMMON\GRAPHICS\AVIS\FILEMOVE.AVI
COMMON\GRAPHICS\AVIS\FILENUKE.AVI
COMMON\GRAPHICS\AVIS\FINDCOMP.AVI
COMMON\GRAPHICS\AVIS\FINDFILE.AVI
COMMON\GRAPHICS\AVIS\SEARCH.AVI
COMMON\GRAPHICS\BITMAPS\ASSORTED\BALLOON.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\BEANY.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\BELL.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\CALENDAR.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\CAMCORD.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\CARD.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\CLUB.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\CUP.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\DELETE.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\DIAMOND.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\ENVELOPE.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\FISH.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\HAND.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\HAPPY.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\HEART.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\INTL_NO.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\KEY.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\MAIL.BMP
COMMON\GRAPHICS\BITMAPS\ASSORTED\NOTE.BMP
..."
Как сделать так, чтобы папки отобразились в TREEVIEW(!) ПРАВИЛЬНО(!!! Т.е. чтобы они не повторялись, лежали пра)... Я уже из сил выбился! Не знаю... Помогите plz!
← →
KilkennyCat © (2005-01-03 23:42) [1]Возможно, неоптимально, но надежно:
Получаем строку := "полный путь к файлу", начинаем выделять имена слева направо до слэша, уменьшая на полученное, и запоминая уровень вложенности, проверяем по всему дереву... если, есть совпадение по уровню и по наименованию, запоминаем ветку дерева и цикл повторяем, но уже в этой ветке; если совпадения нет - добавляем, и цикл снова повторяем для оставшегося пути но уже только для созданной ветки.
например:
Дерево пусто.
получаем COMMON, 1 уровень. проверяем по дереву - ветки нет, создаем, запоминаем созданную ветку. проверяем GRAPHICS... и так до конца.
Берем следующую строку, снова получаем СOMMON, 1 уровень. Проверяем все ветки первого уровня в дереве, находим такую, запоминаем. Получаем GRAPHICS, 2 уровень, проверяем в ветке СOMMON все ее корневые ветки... и так далее.
В принципе, запоминание уровней излишне, просто мне показалось, что так понятней будет.
← →
zt50 © (2005-01-04 00:49) [2]Я так и делал... вот олько ни чего у меня не получилось(
← →
Fay © (2005-01-04 01:07) [3]zt50 © (03.01.05 23:22)
Возможно, Вы ошиблись где-то. Возможно, в 17-й строке.
← →
Gero © (2005-01-04 01:23) [4]
> Возможно, в 17-й строке.
Очень вероятно, кстати.
← →
KilkennyCat © (2005-01-04 01:51) [5]
> zt50 ©
это они намекают, что нехило бы код показать, иначе сказать об ошибке нечего.
← →
zt50 © (2005-01-04 12:25) [6]Говорить мне, что код даже не смахивает на рациональный не надо...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, fdb, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
ListView1: TListView;
Button2: TButton;
TreeView1: TTreeView;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
dirs:TTreeNode;
nodes:TTreeNodes;
Root:TList;
RootDirs:TList;
ChildDirs:TList;
implementation
{$R *.dfm}
procedure ScanDir(StartDir, Mask: String; List: TStrings);
var
SearchRec: TSearchRec;
SD:string;
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 begin
SD:=startdir;
delete(sd,1,3);
List.Add(SD + SearchRec.Name);
end
else if (SearchRec.Name <> "..") and (SearchRec.Name <> ".") then
ScanDir(StartDir + SearchRec.Name + "\",Mask,List);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
function slash(s:string):boolean;
var
i:integer;
begin
result:=true;
for i:=1 to length(s) do
if s[i] = "\" then begin result:=false; break; end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
list: TStrings;
begin
list:= TStringList.Create;
ScanDir("g:\", "*.*", list);
Memo1.Lines:= list;
list.SaveToFile("c:\tft.txt");
list.Free;
end;
procedure CreateItem(cap:string);
var
item:TListItem;
begin
Item:=Form1.ListView1.Items.Add;
Item.Caption:=cap;
end;
procedure CreateChildDir(cap:string);
var
i,j,q:integer;
s:string;
begin
for i:=1 to length(cap) do
if cap[i] = "\" then begin
s:=cap;
delete(s,i,length(s)-i+1);
delete(cap,1,i+1);
break;
end;
end;
function CheckRoot(cap:string):boolean;
var
j:integer;
begin
result:=false;
if root.count > 1 then
for j:=0 to root.count-1 do
if cap = TTreeNode(Root.Items[j]).Text then begin result:=true; break; end;
end;
procedure CreateDir(cap:string);
var
i:integer;
s:string;
dir:TTreeNode;
begin
s:="";
for i:=1 to length(cap) do
if cap[i] = "\" then begin
s:=cap;
delete(s,i,length(s));
delete(cap,1,i);
if CheckRoot(cap) = false then
begin
dir:=TTreeNode.create(nodes);
dir:=Form1.TreeView1.Items.AddNode(dir,dirs,s,nil,naadd);
dir.Item[1].Item[1].Item[1]:=root.Add(dir);
end;
break;
end;
end;
procedure view;
var
s:string;
list:TStrings;
i:integer;
begin
root:=TList.create;
nodes:=TTreeNodes.Create(form1.TreeView1);
dirs:=TTreeNode.create(nodes);
list:= TStringList.Create;
list.LoadFromFile("c:\tft.txt");
for i:=0 to list.Count-1 do
begin
if slash(list.Strings[i]) then CreateItem(list.Strings[i]);
if slash(list.Strings[i]) = false then CreateDir(list.Strings[i])
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
view;
end;
end.
← →
MBo © (2005-01-04 12:40) [7]http://delphibase.endimus.com/?action=viewfunc&topic=filenames&id=10257
← →
zt50 © (2005-01-04 17:33) [8]ОГРОМНОЕ СПАСИБО! СПАИСБООООООООООО!
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.04 c
