Ветки в Object TreeView

← →
Andreev Pavel (2003-10-17 16:34) [0]

Никто не интересовался тем как работает Object TreeView. В частнсти меня интересуют ветки (TComponentSprig, TransientSprig) и, в частности, что делает процедура RegisterSprigType.
Интуитивно мне понятно, что с помощью этих классов определяется, что будет происходить при перетаскивании узлов дерева объектов друг на друга (например, если мы перетащим TADODataSet на TADOConnection, то установится его свойство Connection).
Может кто-то знает где может найти более подробную информацию об этом.

← →
BoBaH (2003-10-24 17:24) [1]

Sprig - сприг - это лист в дереве Object TreeView.
Следующее объяснение этого термина приведено в файле TreeIntf.pas.
{ sprig \Sprig\, n.
[AS. sprec; akin to Icel. sprek a stick. Cf. Spray a branch.]
1. A small shoot or twig of a tree or other plant; a spray; as, a sprig of
laurel or of parsley.
2. A youth; a lad; -- used humorously or in slight disparagement.
A sprig whom I remember, with a whey-face and a satchel, not so many
years ago. --Sir W. Scott.
3. A brad, or nail without a head.
4. (Naut.) A small eyebolt ragged or barbed at the point.
5. A leaf in Delphi"s object treeview
Source: Webster"s Revised Unabridged Dictionary, well sort of anyway }

Это механизм управления поведением узлов в дереве Object TreeView. В этом дереве отображаются компоненты, расположенные на определенной форме. Единственным "интересным" моментом в этом механизме является то, что перетаскивая узлы в этом дереве можно изменять значения некоторых свойств компонент, определяющих их взаимоотношения.
Например, поместим на форму панель и кнопку. Если в Object TreeView перетащить узел кнопки на узел панели, то панель станет владельцем кнопки (т.е. кнопка будет располагаться на панели).
Объявления, управляющие данным механизмом приведены в модуле TreeIntf.pas.
Для начала рассмотрим класс TInformant. Это класс объекта, способного управлять уведомлениями (нотификациями). Объявление данного класса приведено ниже:
TInformant = class
protected
// Получение уведомления от данного объекта
procedure Changed(AObj: TInformant); virtual;
public
// Флаг, указывающий на то, что объект удаляется
property Destroying: Boolean read FDestroying;

procedure BeforeDestruction; override;
destructor Destroy; override;
// Блокировка уведомлений
procedure DisableNotify;
// Разблокировка уведомлений
procedure EnableNotify;
// Посылка уведомлений
procedure Notification;
// Добавление в список уведомляемых объектов
// (запрос на получение уведомлений)
procedure Notify(AObj: TInformant);
// Удаление из списка уведомляемых объектов
// ("отписка" от уведомлений)
procedure Unnotify(AObj: TInformant);
end;
Перед уничтожением объекта (в методе BeforeDestruction) всем объектам из списка уведомляемых посылается уведомление. В методе Changed класса TInformant проверяется не уничтожается ли объект, пославший уведомление, и если да, то посылается "отписка" (вызывается его метод Unnotify).
Непосредственно от данного объекта наследует класс TSprig, представляющий собой ветку дерева объектов. Отметим, что непосредственно он представляет собой один узел дерева объектов, содержит ссылку на предка в дереве и список потомков. Данный элемент может представлять собой любой объект, наследующий от TPersistent.
Данный класс содержит различные методы для управления деревом объектов. Подробное рассмотрение данных методов не имеет большой практической ценности.
Различные потомки данного класса представляют собой различные типы узлов дерева:
TAbstractSprig - представляет объект, который реально не существует.
TTransientSprig - временный объект (используется для представления объектов, свойства которых еще не инициализированы необходимым образом для их использования).
TPersistentSprig - только наследует от TSprig, ничего не добавляя.
TComponentSprig - представляет компонент.
Для сопоставления классов и представляющих их спригов используется метод RegisterSprigType:

procedure RegisterSprigType(const AClass: TClass; ASprigClass: TSprigClass);

Единственным практическим применением для спригов является переопределение стандартных спригов для изменения их поведения при перетаскивании узлов в дереве объектов. Для этого используются следующие методы класса TSprig:

TSprig = class(TInformant)
...
// Обновление визуального отбражения
// (обновляется не только дерево объектов, но и Инспектор объектов)
procedure VisualRefresh; virtual;
...
// Возвращает класс перетаскиваемого объекта (Item.ClassType)
function DragClass: TClass;
// Можно ли перетащить данный сприг на данный сприг
function DragOver(AItem: TSprig): Boolean; virtual;
// Можно ли на данный сприг перетащить данный сприг
function DragOverTo(AParent: TSprig): Boolean; virtual;
// Перещить данный сприг на данный сприг
function DragDrop(AItem: TSprig): Boolean; virtual;
// На данный сприг перетащить данный сприг
function DragDropTo(AParent: TSprig): Boolean; virtual;
// Определение, может ли данный сприг быть предком в дереве данному спригу
class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
...
// Опредедение, кто является предком данного сприга в дереве
procedure FigureParent; virtual;
// Определение потомков данного сприга
procedure FigureChildren; virtual;
end;

Ниже приведен пример использования спригов:

unit Acceptor;

interface

uses
SysUtils, Classes, Controls, ExtCtrls, TreeIntf, Dialogs;

type
TAcceptor = class(TPanel)
end;

TTaken = class(TPanel)
private
procedure SetAcceptor(const Value: TAcceptor);
protected
FAcceptor: TAcceptor;
published
property Acceptor: TAcceptor read FAcceptor write SetAcceptor;
end;

procedure Register;

implementation

{ TTaken }

procedure TTaken.SetAcceptor(const Value: TAcceptor);
begin
FAcceptor := Value;
Caption := FAcceptor.Caption;
end;

type
TAcceptorSprig = class(TComponentSprig)
end;
TTakenSprig = class(TComponentSprig)
public
procedure FigureParent; override;
function DragDropTo(AItem: TSprig): Boolean; override;
function DragOverTo(AItem: TSprig): Boolean; override;
class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
end;

{ TTakenSprig }

function TTakenSprig.DragDropTo(AItem: TSprig): Boolean;
begin
(Item as TTaken).Acceptor := (AItem as TAcceptorSprig).Item as TAcceptor;
VisualRefresh;
Result := true;
end;

function TTakenSprig.DragOverTo(AItem: TSprig): Boolean;
begin
Result := AItem is TAcceptorSprig or inherited DragOverTo(AItem);
end;

procedure TTakenSprig.FigureParent;
begin
with TTaken(Item) do
if Assigned(Acceptor)
then SeekParent(Acceptor).Add(Self)
else inherited;
end;

class function TTakenSprig.PaletteOverTo(AParent: TSprig;
AClass: TClass): Boolean;
begin
Result := AParent is TAcceptorSprig or inherited PaletteOverTo(AParent, AClass);
end;

procedure Register;
begin
RegisterComponents("temp", [TAcceptor, TTaken]);
RegisterSprigType(TAcceptor, TAcceptorSprig);
RegisterSprigType(TTaken, TTakenSprig);
end;

end.

Для приведенного выше примера необходимо включить в секцию requires его пакета пакет DesignIDE. В приведенном выше примере при перетаскивании в дереве объектов спригов класса TTaken на сприги класса TAcceptor изменяется их свойство Acceptor, а также они становятся потомками соответствующего сприга.

Учись, студент!

Ветки в Object TreeView Найти похожие ветки