Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2009.07.12;
Скачать: [xml.tar.bz2];

Вниз

Построение дерева   Найти похожие ветки 

 
{RASkov} ©   (2009-05-23 20:18) [0]

Что-то не соображу как мне построить дерево имея список путей. Например:
var Lst: TStringList //содержит >
{WINDOWS\FONTS
WINDOWS\Web
WINDOWS\Help\Tours
WINDOWS\Help\Tours\htmlTour
WINDOWS\Cursors
TEMP\DIR1
TEMP\DIR2\Dir3}


Дерево нужно в TTreeView построить:

WINDOWS
     \-Cursors
     \-FONTS
     \-HELP
           \-Tours
                 \-htmlTour
     \Web
TEMP
  \-Dir1
  \-Dir2
       \-Dir3


Если поплывет, думаю понятно какое дерево должно получится.... как в проводнике.)
Помогите алгоритмом люди добрые :) Т.е. алгоритм у меня в голове крутится, но что-то он мне представляется монстроидальным из кучи строк, но чую, что тут всю гораздо проще, но не соображу как :(


 
@!!ex ©   (2009-05-23 20:29) [1]

Только здесь разделитель - "&"
Function GetName(var s:string):string;
begin
 if pos("&",s)>0 then begin
   Result:=Copy(s,1,pos("&",s)-1);
   s:=Copy(s,pos("&",s)+1,Length(s));
 end
 else begin
   Result:=s;
   s:="";
 end;

end;

Function pl_tab_Items_GetNodeByPath(Obj: TTabObject; path:pchar):TTreeNode; stdcall;
var
 s:string;
 Node:TTreeNode;
 name:string;
 fullpath:string;
begin
 fullpath:=path;
 Result:=nil;
 case PObjectInfo(Obj.Tag)^._Type of
   OBJECT_TYPE_TREEVIEW:begin

     s:=fullpath;
     name:=GetName(s);
     Node:=nil;
     while name<>"" do begin
       Node:=GetNode(TTreeView(Obj),Node,name);
       name:=GetName(s);
     end;
     Result:=Node;
   end;
 end;
 TTreeView(Obj).Items[0].Expand(false);
end;


 
Влад   (2009-05-23 20:30) [2]

Так а в чём проблема то ?

Разбиваешь строку вида "WINDOWS\Help\Tours\htmlTour" по разделителям
получаешь
1. WINDOWS
2. Help
3. Tours
4. htmlTour
далее циклом по узлам дерева в зависимости от уровня вложености.


 
@!!ex ©   (2009-05-23 20:31) [3]

> [1] @!!ex ©   (23.05.09 20:29)

GetNode забыл.
function GetNode(TreeView:TTreeView; Node:TTreeNode; const name:string):TTreeNode;
var
 i:integer;
begin
 Result:=nil;
 if Node=nil then begin
   for i:=0 to TreeView.Items.Count-1 do
     if (TreeView.Items[i].Text=name) and (TreeView.Items[i].Parent=nil) then begin
       Result:=TreeView.Items[i];
       Exit;
     end;
 end
 else begin
   for i:=0 to Node.Count-1 do
     if Node.Item[i].Text=name then begin
       Result:=Node.Item[i];
       Exit;
     end;
 end;
 if Result=nil then begin
   Result:=TreeView.Items.AddChild(Node,name);
   Result.Data:=nil;
 end;
end;


 
{RASkov} ©   (2009-05-23 20:37) [4]

Хм.... спасибо.
Я вот тоже нашел в инете:
http://delphidb.info/4259_sl_to_dir_tree.html
Сейчас будем выявлять лучший алгоритм :)


 
turbouser ©   (2009-05-23 21:18) [5]

Набросал от нефиг делать.. Может подойдет :)
function NextWord(AString: string; FromPos: integer;
 ADelimiter: char; var CurPos: integer): string;
var
 i, ALen: integer;
begin
 ALen := Length(AString);
 if (ALen = 0) or (FromPos < 0) or (ALen < FromPos) then
 begin
   Result := "";
   CurPos := -1;
 end
 else
   for i := FromPos to ALen do
     if (AString[i] = ADelimiter) or (i = ALen) then
     begin
       CurPos := Succ(i);
       if (i = ALen) then
         Result := Copy(Astring, FromPos, i - Pred(FromPos))
       else
         Result := Copy(Astring, FromPos, i - FromPos);
       Break;
     end;
end;

function StringToTreeItems(Value: string; Tree: TTreeView;
 ADelimiter: char): TTreeNode;
var
 i, CurPos: integer;
 CurrentWord: string;
 TempNode: TTreeNode;
 ItemFound: boolean;
begin
 CurPos := 1;
 ItemFound := false;
 TempNode := nil;
 CurrentWord := NextWord(Value, CurPos, ADelimiter, CurPos);
 while (CurrentWord > "") do
 begin
   if TempNode = nil then
     TempNode := Tree.Items.Add(nil, CurrentWord)
   else
   begin
     for i := 0 to Pred(TempNode.Count) do
       if AnsiSameStr(TempNode.Item[i].Text, CurrentWord) then
       begin
         TempNode := TempNode.Item[i];
         ItemFound := True;
         Break;
       end;
     if not ItemFound then
       TempNode := Tree.Items.AddChild(TempNode, CurrentWord);
   end;
   ItemFound := false;
   CurrentWord := NextWord(Value, CurPos, ADelimiter, CurPos);
 end;
 Result := TempNode;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i: integer;
 AStrings: TStrings;
begin
 AStrings := TStringList.Create;
 AStrings.Text :=
   "WINDOWS\FONTS"#13#10 +
   "WINDOWS\Web"#13#10 +
   "WINDOWS\Help\Tours"#13#10 +
   "WINDOWS\Help\Tours\htmlTour"#13#10 +
   "WINDOWS\Cursors"#13#10 +
   "TEMP\DIR1"#13#10 +
   "TEMP\DIR2\Dir3"#13#10;
 try
   TreeView1.Items.Clear;
   for i := 0 to Pred(AStrings.Count) do
     StringToTreeItems(AStrings[i], TreeView1, "\");
 finally
   AStrings.Free;
 end;
end;


 
{RASkov} ©   (2009-05-23 21:25) [6]

> [5] turbouser ©   (23.05.09 21:18)

Спасибо :)


 
{RASkov} ©   (2009-05-23 21:30) [7]

> [5] turbouser ©   (23.05.09 21:18)

Хм.... немного не так :) Ну да ладно.... я суть понял.
Как и догадывался изначально, это не парой строчками кода делается :)


 
turbouser ©   (2009-05-23 21:34) [8]


> {RASkov} ©   (23.05.09 21:30) [7]
>
> > [5] turbouser ©   (23.05.09 21:18)
>
> Хм.... немного не так :)

А.. точно :)
Ну, добавить еще пару строчек и все будет ОК :)



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

Форум: "Начинающим";
Текущий архив: 2009.07.12;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.006 c
4-1212461746
Надо узнать код
2008-06-03 06:55
2009.07.12
Имитация нажатия мышы


15-1242131415
12
2009-05-12 16:30
2009.07.12
Seagate Crystal Reports. Просто вставить тхт/bmp в detail


15-1242320026
VoznikVopros
2009-05-14 20:53
2009.07.12
Где можно взять красивые иконки для базы данных?..


2-1242802069
roadster
2009-05-20 10:47
2009.07.12
Зашитые в код строковые константы- как защитить их от просмотра?


2-1242810369
И. Павел
2009-05-20 13:06
2009.07.12
Как создать письмо, содержащее несколько строк?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский