Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];
ВнизСохранение 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;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.11 c