Здравствуйте!
Есть тема "Иерархия структуры таблицы Менделеева", в пределах которой нужно построить иерархию объектов, состоящей как минимум из 3-х уровней.
Для демонстрации работы построенной иерархии классов, создаётся приложение, позволяющее:
создавать, удалять объекты, изменять характеристики объектов, визуализировать объекты, манипулировать на форме объектами, сохранять/считывать текущее состояние объектов в формате XML.
Есть некоторые задумки насчёт иерархии (изображение)...Может кто-нибудь подскажет другой подход?
Ну а прежде всего - трудности с визуализацией и манипулированием объектами...Может быть у кого-нибудь есть идеи, как для начала идейно подойти к этим вопросам? что можно придумать? Подскажите пожалуйста..!
Эскизы прикрепленных изображений
Пока описала свой класс TBPeriod:
unit UnitClasses;
interface
type TBPeriod=class
private
fBTitle:string;
function GetBTitle:string;
procedure SetBTitle(newBTitle:string);
public
property BTitle:string read GetBTitle write SetBTitle;
constructor Create(fBTitle:string);
end;
implementation
Uses UnitMain;
constructor TBPeriod.Create(fBTitle:string);
begin
inherited Create;
BTitle:=fBTitle;
end;
function TBPeriod.GetBTitle:string;
begin
Result:=fBTitle;
end;
procedure TBPeriod.SetBTitle(newBTitle:string);
begin
fBTitle:=newBTitle;
end;
end.
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, StdCtrls, ComCtrls, ExtCtrls, Buttons;
type
TFormMain = class(TForm)
XPManifest1: TXPManifest;
TreeViewMain: TTreeView;
LabMainStruct: TLabel;
TreeViewNew: TTreeView;
BitBtnCreateBPer: TBitBtn;
RadioGroupPeriod: TRadioGroup;
EditTitlePer: TEdit;
procedure BitBtnCreateBPerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
Uses UnitClasses;
{$R *.dfm}
procedure TFormMain.BitBtnCreateBPerClick(Sender: TObject);
var
NewBPeriod:TBPeriod;
title:string;
begin
case RadioGroupPeriod.ItemIndex of
0: begin
title:=EditTitlePer.Text;
NewBPeriod:=TBPeriod.Create(title);
//Вот здесь меня не пропускает с несоответствием типов... Подскажите пожалуйста, как тут быть?
FormMain.TreeViewNew.Items.AddObject(title, NewBPeriod as TObject);
end;
1: ;
else
MessageDlg('Выберите пункт создания',mtError,[mbOK],0);
end;
end;
end.
FormMain.TreeViewNew.Items.AddObject(nil, title, NewBPeriod as TObject);, ну или передавай вместо nil тот элемент, после которого будет вставлен новый. Проще всего выбрать нужный тебе узел, и сделать:
FormMain.TreeViewNew.Items.AddObject(FormMain.TreeViewNew.Selected, title, NewBPeriod as TObject);, тогда новый узел добавится как сосед выбранного.
Вопрос насчёт создания класса-потомка для моего класса TBPeriod..
type TRange=class(TBPeriod)
// ....
end;
type
TPeriod = class
title: string;
constructor create(const s: string);
end;
TRange = class(TBase)
min, max: integer; // только для иллюстрации, я не знаю, что ты хочешь хранить в этом классе
constructor create(const s: string; amin, amax: integer);
end;
constructor TPeriod.create(const s: string);
begin
inherited create;
title := s;
end;
constructor TRange.create(const s: string; amin, amax: integer);
begin
inherited create(s); // <--- Поля предка инициализированы ЕГО конструктором
min := amin, max := amax; // А теперь инициализируем новые поля
end;
FormMain.TreeViewNew.Items.AddObject(FormMain.TreeViewNew.Selected, title, NewBPeriod as TObject);, тогда новый узел добавится как сосед выбранного.
Ещё один вопрос по классам...
Есть класс TPeriod и его наследник TRange..
unit UnitClasses;
interface
type TPeriod=class
Title:string;
Feature:string;
constructor Create(s:string;aFeature:string);
end;
type TRange=class(TPeriod)
constructor Create(s:string);
end;
во 2-м конструкторе компилятор сигнализирует об ошибке..Природа этой ошибки мне ясна (не все параметры указаны)...Но как обойти эту ошибку? Ведь у меня в потомке только поле title без Feature...
implementation
Uses UnitMain;
constructor TPeriod.Create(s:string;aFeature:string);
begin
inherited Create;
Title:=s;
Feature:=aFeature;
end;
constructor TRange.Create(s:string);
begin
inherited Create(s);
end;
end.
Например, я добавила в TreeView объект с некоторыми характеристиками (в TreeView отображается из них заголовок)..Выделила его..Скажите пожалуйста, что нужно сделать, чтобы теперь просмотреть этот объект?
Совсем забыл уточнить, что для работы с TTreeView твои классы должны быть унаследованы от TObject... То есть, вот так:
type
TBPeriod = class(TObject) // внимательно, наследник TObject !!!
private
fBTitle:string;
function GetBTitle:string;
procedure SetBTitle(newBTitle:string);
public
sData: string; // Просто для иллюстрации - эта строка будет хранимой информацией
property BTitle:string read GetBTitle write SetBTitle;
constructor Create(fBTitle, data:string);
end;
constructor TBPeriod.Create(fBTitle, data:string);
begin
inherited Create;
BTitle := fBTitle;
sData := data;
end;
function TBPeriod.GetBTitle:string;
begin
Result := fBTitle;
end;
procedure TBPeriod.SetBTitle(newBTitle:string);
begin
fBTitle := newBTitle;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
NewBPeriod: TBPeriod;
title: string;
begin
case RadioGroupPeriod.ItemIndex of
0:
begin
title := EditTitlePer.Text;
NewBPeriod := TBPeriod.Create(title, Edit1.Text);
TreeView1.Items.AddChildObject(
// так заносим данные, это ты уже видела
TreeView1.Selected, title, NewBPeriod as TObject
);
end;
1: ;
else
MessageDlg('Выберите пункт создания',mtError,[mbOK],0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// А вот так - получаем доступ к данным
ShowMessage(TBPeriod(TreeView1.Selected.Data).sData);
end;
У меня возник вопрос по Drag&Drop..
Я хочу реализовать такое действие: при перетаскивании элемента из TreeView на Image соответствующий узел (и связанный с ним объект) удаляется..
Попыталась таким образом:
procedure TFormMain.ImageDelDragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
if Source = TreeViewNew then
// Удаляем из источника
TTreeView(Source).Items.Delete(TTreeView(Source).Selected);
end;
procedure TFormMain.ImageDelDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := (Source = TreeViewNew);
end;
procedure TFormMain.ImageDelDragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
if Source = TreeViewNew then
// Удаляем из источника
TTreeView(Source).Items.Delete(TTreeView(Source).Selected);
end;
procedure TFormMain.ImageDelDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := (Source = TreeViewNew);
end;
Пусть я определила функцию, процедуру и свойство для класса TBPeriod:
type
TBPeriod = class(TObject) // внимательно, наследник TObject !!!
private
fBTitle:string;
public
sData: string; // Просто для иллюстрации - эта строка будет хранимой информацией
function GetsData:string;
procedure SetsData(newsData:string);
property Data:string read GetsData write SetsData;
constructor Create(fBTitle, data:string);
end;
///////////
function TBPeriod.GetsData:string;
begin
Result:=sData;
end;
procedure TBPeriod.SetsData(newsData:string);
begin
sData:=newsData;
end;
Ой..повторилась история с постом от "Гость"..
TBPeriod(TreeViewNew.Selected.Data).Data := EditNewValue.Text; // изменяешь свойство Data нужного объекта
Снова вопрос по Drag&Drop..теперь в пределах TreeView..т.е. перемещение узлов.
Нашла в DRKB пример по этому вопросу...
procedure TFormMain.MoveNode(TargetNode, SourceNode: TTreeNode);
var
nodeTmp: TTreeNode;
i: Integer;
begin
with TreeViewNew do
begin
nodeTmp := Items.AddChild(TargetNode, SourceNode.Text);
for i := 0 to SourceNode.Count - 1 do
begin
MoveNode(nodeTmp, SourceNode.Item[i]);
end;
end;
end;
procedure TFormMain.TreeViewNewDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
TargetNode, SourceNode: TTreeNode;
begin
with TreeViewNew do
begin
TargetNode := GetNodeAt(X, Y); // Get target node
SourceNode := Selected;
if (TargetNode = nil) then
begin
EndDrag(False);
Exit;
end;
MoveNode(TargetNode, SourceNode);
SourceNode.Free;
end;
end;
procedure TFormMain.TreeViewNewDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
if (Sender = TreeViewNew) then // If TRUE than accept the draged item
begin
Accept := True;
end;
end;
nodeTmp := Items.AddChild(TargetNode, SourceNode.Text);
nodeTmp := Items.AddChildObject(TargetNode, SourceNode.Text, SourceNode.Data);
nodeTmp := Items.AddChild(TargetNode, SourceNode.Text);
nodeTmp := Items.AddChildObject(TargetNode, SourceNode.Text, SourceNode.Data);
А скажите пожалуйста, где будет лежать создаваемый таким образом файлик *.XML?
Судя по строке
XMLDoc.SaveToFile(ChangeFileExt(ParamStr(0),'.XML'));, там же, где и EXE-шник.
Твои атрибуты... Смотри, сохранять дерево (вместе с тем, что хранится в объектах, связанных с узлами), можно так:
procedure Tree2XML(tree: TTreeView);Чтобы восстановить из XML сохраненное таким образом дерево:
var
tn : TTreeNode;
XMLDoc : TXMLDocument;
iNode : IXMLNode;
procedure ProcessTreeItem(tn: TTreeNode; iNode: IXMLNode);
var cNode : IXMLNode;
begin
if tn = nil then Exit;
cNode := iNode.AddChild('item');
cNode.Attributes['text'] := tn.Text;
cNode.Attributes['imageIndex'] := tn.ImageIndex;
cNode.Attributes['stateIndex'] := tn.StateIndex;
// Вот это и есть твой атрибут ...
if tn.Data <> nil then begin
cNode.Attributes['sData'] := TBPeriod(tn.Data).sData;
end
else cNode.Attributes['sData'] := '';
tn := tn.getFirstChild;
while tn <> nil do begin
ProcessTreeItem(tn, cNode);
tn := tn.getNextSibling;
end;
end; (*ProcessTreeItem*)
begin
XMLDoc := TXMLDocument.Create(nil);
XMLDoc.Active := True;
iNode := XMLDoc.AddChild('tree2xml');
iNode.Attributes['app'] := ParamStr(0);
tn := tree.TopItem;
while tn <> nil do begin
ProcessTreeItem (tn, iNode);
tn := tn.getNextSibling;
end;
XMLDoc.SaveToFile(ChangeFileExt(ParamStr(0),'.XML'));
XMLDoc := nil;
end; (* Tree2XML *)
procedure TForm1.btnSaveXMLClick(Sender: TObject);
begin
Tree2XML(TreeView1);
end;
procedure XML2Tree(tree: TTreeView; XMLDoc: TXMLDocument);(я для проверки сохранял из одного дерева, восстанавливал в другое... Из доп. информации сохраняется только строка Data, если у тебя есть еще что-то добавляй и в ProcessTreeItem, и в ProcessNode)...
var
iNode : IXMLNode;
procedure ProcessNode(Node : IXMLNode; tn: TTreeNode);
var
cNode : IXMLNode;
newPeriod: TBPeriod;
begin
if Node = nil then Exit;
with Node do begin
// Есть сохраненные атрибуты? Восстанавливаем ...
if Attributes['sData'] <> '' then begin
newPeriod := TBPeriod.Create(
Attributes['text'], Attributes['sData']
);
tn := tree.Items.AddChildObject(
tn, Attributes['text'], newPeriod as TObject
);
end
else // Нету? И не надо ...
tn := tree.Items.AddChild(tn, Attributes['text']);
tn.ImageIndex := Integer(Attributes['imageIndex']);
tn.StateIndex := Integer(Attributes['stateIndex']);
end;
cNode := Node.ChildNodes.First;
while cNode <> nil do begin
ProcessNode(cNode, tn);
cNode := cNode.NextSibling;
end;
end; (*ProcessNode*)
begin
tree.Items.Clear;
XMLDoc.FileName := ChangeFileExt(ParamStr(0),'.XML');
XMLDoc.Active := True;
iNode := XMLDoc.DocumentElement.ChildNodes.First;
while iNode <> nil do begin
ProcessNode(iNode,nil);
iNode := iNode.NextSibling;
end;
XMLDoc.Active := False;
end;
procedure TForm1.btnLoadTreeClick(Sender: TObject);
var
ParentObj: TComponent;
XMLDoc: TXMLDocument;
begin
ParentObj := TComponent.Create(nil);
XMLDoc := TXMLDocument.Create(ParentObj);
XML2Tree(TreeView2, XMLDoc);
end;
Мне вот ещё что не понятно...
Как быть при записи/чтении в/из *.XML в случае, если TBPeriod имеет наследника TRange, который в свою очередь - TGroup, для TGroup есть наследник TUnderGroup, и для последнего - наследник TElement (причём объекты верхних ступенек иерархии имееют одни и те же поля, а TElement - в дополнии к ним ещё и новые..как учесть это??)
Объясните пожалуйста!
cNode.Attributes['ID'] := TBPeriod(tn.Data).GetID;
//сохраняем...
if tn.Data <> nil then begin
cNode.Attributes['Feature'] := TPeriod(tn.Data).Feature;
cNode.Attributes['Count'] := TPeriod(tn.Data).Count;
cNode.Attributes['Id']:=1;
end
else cNode.Attributes['sData'] := '';
Ну, например, так:
if tn.Data <> nil then begin
// значит, есть связанный с узлом объект... смотрим, какого он типа:
if TBPeriod(tn.Data) is TElement then begin
// здесь пишутся данные из класса TElement или его потомков
end
else begin
// здесь - изо всех остальных классов (до TElement в цепочке наследования)
end;
end
else cNode.Attributes['sData'] := '';
Вот такой вопрос возник..
Если я хочу создать очередной узел (по нажатию соответствующей кнопки), то сначала в TreeView мне нужно выделить узел-родитель..Хочу сделать контроль возможности неверного выделения..
Скажите пожалуйста, как в этом случае сообщить о нарушении иерархии, если вместо предполагаемого родительского узла выделен узел того же уровня, что и новый или выделен узел, стоящий выше предполагаемого родительского?
Ну, если дерево будет именно таким, как было сказано в самом первом посте, то с этим проблем нет, можно в конце концов выделять римские числа в заголовках узлов и проверять, подходит ли потомок к выбранному предку... А вот если я в группу "Неметаллы" захочу внести Селен и Теллур - ты сама, не заглядывая в таблицу вряд ли сможешь определить (по смыслу) ошибся ли я, и какой именно элемент не подходит для данной группы. Так что только по смыслу здесь не пойдет. Нужна какая-то доп. информация.
А, вот ты о чем... Ну, это просто: у каждого узла дерева есть поле Level (уровень, на котором этот узел находится), тебе надо будет всего навсего проверить его...
Скажем, при нажатии на кнопку в твоем примере проверка должна быть:
if TreeView1.Selected.Level = 2 then begin // Level начинается с 0
// Здесь добавление узла, как обычно
end
else ShowMessage('Подгруппа - это наследник Группа');
Спасибо!!)
Получилось, как и хотела!!)
И ещё один вопрос..в таком же духе..
Вот таким образом было сделано перемещение узлов в пределах TreeViewNew:
procedure TFormMain.MoveNode(TargetNode, SourceNode: TTreeNode);
var
nodeTmp: TTreeNode;
i: Integer;
begin
with TreeViewNew do
begin
nodeTmp := Items.AddChildObject(TargetNode, SourceNode.Text, SourceNode.Data);
for i := 0 to SourceNode.Count - 1 do
begin
MoveNode(nodeTmp, SourceNode.Item[i]);
end;
end;
end;
procedure TFormMain.TreeViewNewDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
TargetNode, SourceNode: TTreeNode;
begin
with TreeViewNew do
begin
TargetNode := GetNodeAt(X, Y); // Get target node
SourceNode := Selected;
if (TargetNode = nil) then
begin
EndDrag(False);
Exit;
end;
MoveNode(TargetNode, SourceNode);
SourceNode.Free;
end;
end;
procedure TFormMain.TreeViewNewDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
if (Sender = TreeViewNew) then // If TRUE than accept the draged item
begin
Accept := True;
end;
end;
procedure TFormMain.TreeViewNewDragDrop(Sender, Source: TObject; X,Это имела в виду?
Y: Integer);
var
TargetNode, SourceNode: TTreeNode;
begin
with TreeViewNew do
begin
TargetNode := GetNodeAt(X, Y); // Get target node
SourceNode := Selected;
if (TargetNode = nil) or (TargetNode.Level + 1 <> SourceNode.Level) then // <---
begin
EndDrag(False);
Exit;
end;
MoveNode(TargetNode, SourceNode);
SourceNode.Free;
end;
end;