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

Вниз

Сохранение TreeView в текст   Найти похожие ветки 

 
Danco ©   (2010-05-06 17:11) [0]

Добрый вечер! Помогите разораться с компонентом TreeView.

Дерево выглядит примерно так:

0
---0
---1
---2
------0
------1
1
---0
---1
------0
------1
---------0
---------1
---------2
---2
---3

Как сохранить в текстовый файл или просто вывести в memo поле в таком варианте:

0;0
0;1
0;2
0;2;0
0;2;1
1;0
1;1
1;1;0
1;1;1
1;1;1;0
1;1;1;1
1;1;1;2
1;2
1;3

Заранее спасибо!


 
xayam ©   (2010-05-06 17:23) [1]

Рекурсия?

http://www.delphimaster.net/view/11-1204867469


 
Danco ©   (2010-05-06 17:23) [2]

Для более нормального понимания:

Погода
---Разная
---Спортивная
---Антисанитарная
------Политичски
------Факторитически
Температура
---Анамальная
---Мировая
------Адекватная
------Шумная
---------Средне
---------Норма
---------Сильно
---Метежная
---Индустриальная

--->

Погода;Разная
Погода;Спортивная
Погода;Антисанитарная
Погода;Антисанитарная;Политичски
Погода;Антисанитарная;Факторитически
Температура;Анамальная
Температура;Мировая
Температура;Мировая;Адекватная
Температура;Мировая;Шумная
Температура;Мировая;Шумная;Средне
Температура;Мировая;Шумная;Норма
Температура;Мировая;Шумная;Сильно
Температура;Метежная
Температура;Индустриальная


 
xayam ©   (2010-05-06 17:27) [3]

И потом там вроде есть
TreeView1.SaveToFile();
TreeView1.LoadFromFile();


 
danco ©   (2010-05-06 17:32) [4]


> Рекурсия?


function Save2File(Sender:TTreeView): Boolean;
var
F: HFile;

procedure item2file(ind:cardinal);
var
 len:cardinal;
 path: String;
begin
 while ind<>0 do
   begin
     path := sender.TVItemPath(ind,"\");
     len :=length(path) ;
     FileWrite( F, len,4);
     FileWrite( F, path[1], len );
     if Sender.TVItemChild[ind]<>0 then item2file(Sender.TVItemChild[ind]);
     ind := sender.TVItemNext[ind];
   end;
 end;

begin
 result := false;
 F := FileCreate("Base.dat", ofOpenWrite or ofCreateAlways);// or ofShareExclusive ofShareDenyRead or ofShareDenyWrite
 if F = INVALID_HANDLE_VALUE then Exit;
 item2file(Sender.TVRoot);
 FileClose( F );
 result := true;
end;


Данный код работать не хочет, т.к. в данный пример для компонента TKOLTreeView

Или я что-то недопонимаю?


 
xayam ©   (2010-05-06 17:40) [5]

Ну это просто пример рекурсии, можешь под себя подправить, если лень, то можно упростить до предела:

procedure TForm1.Button1Click(Sender: TObject);
var
  F: TFileStream;
begin
  F := TFileStream.Create("c:\TreeView.txt", fmCreate or fmShareCompat);
  try
    F.WriteComponent(TreeView1);
  finally
    F.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  F: TFileStream;
begin
  F := TFileStream.Create("c:\TreeView.txt", fmOpenRead or fmShareDenyWrite);
  try
    F.ReadComponent(TreeView1);
  finally
    F.Free;
  end;
end;


 
danco ©   (2010-05-06 17:52) [6]

Это просто сохранение TreeView в текстовой файл, а мне нужно в определенном формате описанным выше.

for i:=0 to TreeView1.Items.Count-1 do
 begin
   ListBox1.Items.Add(TreeView1.Items.Item[i].Text);
end;


Получилось перебрать только все дерево по порядку.


 
MBo ©   (2010-05-06 17:57) [7]

>Получилось перебрать только все дерево по порядку.
уже ведь подсказали, что нужно использовать рекурсивную процедуру.

можно и итеративно в цикле по Items, только лишнюю работу придется делать - пробегать по Parent-ам


 
danco ©   (2010-05-06 19:31) [8]

С рекрусивными процедурами не разобрался, попробовал через Items, получилось, но никак до ума не могу довести.

procedure TForm1.Button1Click(Sender: TObject);
var
 i,l,pl,
 ListLevel, IndexLevel: Integer;
 s,sp: String;
begin
 for i:=0 to TreeView1.Items.Count-1 do
 begin
   ListLevel:=TreeView1.Items.Item[i].Level;
   IndexLevel:=TreeView1.Items.Item[i].Index;

   if ListLevel = 0 then
   begin
     s:="";
     l:=0;
   end
     else
       begin
         if l<ListLevel then
           s:=s+TreeView1.Items.Item[i-1].Text+":"
             else
               if l>ListLevel then
               begin
                 l:=l-ListLevel;
                 sp:=s;
                 s:="";
                 for pl:=0 to l do
                 begin
                  s:=s+Copy(sp,1,pos(":",sp));
                  Delete(sp,1,pos(":",sp));
                 end;
               end;
         l:=ListLevel;
       end;

   ListBox1.Items.Add(s+TreeView1.Items.Item[i].Text);
 end;
end;


Тыкните пальцем пожалуйста где недочет, я слепой видимо. Или сразу мне в глаз, прозрею может =)))


 
xayam ©   (2010-05-06 21:08) [9]


> С рекрусивными процедурами не разобрался

Вот так потестируй на разных данных, вроде должно работать, если я не ошибся:

procedure TForm1.RecurceTree(Node: TTreeNode);
var s: string;
    curr: TTreeNode;
begin
    if Node.HasChildren then Node:= Node.getFirstChild
    else  exit;
    while Node <> nil do begin
          curr:= Node;
          s:= curr.Text + ";";
          while curr.Parent <> nil do begin
                curr:= curr.Parent;
                s:= curr.Text + ";" + s;
          end;
          Memo1.Lines.add( s );
       if Node.HasChildren then RecurceTree(Node);
          Node:= Node.getNextSibling;
    end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
     for i:= 0 to TreeView1.Items.Count - 1 do
     if TreeView1.Items[i].Parent = nil
     then begin
          Memo1.Lines.add( TreeView1.Items.Item[i].Text + ";" );
          RecurceTree(TreeView1.Items.Item[i])
     end;
end;


 
xayam ©   (2010-05-06 21:11) [10]

не оптимально написано, но я просто не помню как получить корневой узел дерева. Если знаешь, то последняя процедура должна быть примерно такой (без цикла):

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
         RecurceTree(Tree_View_Root_Node);
end;


 
xayam ©   (2010-05-06 21:30) [11]

Хотя можно просто так написать

procedure TForm1.Button1Click(Sender: TObject);
begin
          RecurceTree(TreeView1.Items.Item[0]);
end;

и в дереве сделать корневой элемент, в который вложены все подразделы.


 
danco ©   (2010-05-07 02:04) [12]


> xayam ©   (06.05.10 21:08) [9]


Спасибо большое! Все работает! Примногом благодарен!



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

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

Наверх




Память: 0.5 MB
Время: 0.174 c
15-1273645654
uniken1
2010-05-12 10:27
2010.08.27
DoubleBuffer в чужом окне


2-1272391252
romario
2010-04-27 22:00
2010.08.27
Сохранение файла на диск


15-1270240202
Юрий
2010-04-03 00:30
2010.08.27
С днем рождения ! 3 апреля 2010 суббота


15-1273226208
MeF Dei Corvi
2010-05-07 13:56
2010.08.27
Детский вопрос про физику, тучи и термодинамику


15-1271837525
@!!ex
2010-04-21 12:12
2010.08.27
60км/ч -> бетонная стена. Какой результат?