| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Вложенные события [D6, Win2k, WinXP]

DimaBr ©   (2006-01-20 13:49:00) 

Здравствуйте !!!
Для того чтобы в инспекторе получить сложное свойство необходимо породить класс от TPersistent с реализацией требуемых свойств и методов. Однако данный подход почемуто не распостраняется на события.
Как правильно реализовать вложенные событияб чтобы на вкладке Events тоже появился плюсик с раскрывающимся списком событий.

---

DimaBr   (2006-01-23 14:40:00) [1]

Спасибо, буду пробывать.

---

Юрий Зотов   (2006-01-23 14:20:00) [2]

Пояснение.

Код метода TInternalObject.AssignTo должен быть Вашим собственным, здесь он написан именно таким только для примера и для тестирования Тестирование заключается в просмотре формы в виде текста и снова в виде формы (в DFM должны сохраняться назначенные события внутреннего объекта) и в проверке вызова их обработчиков. В данном случае они вызываются, например, так:

procedure TForm1.FormClick(Sender: TObject);
begin
 InternalObjectContainer1.InternalObject := InternalObjectContainer1.InternalObject // Срабатывает AssignTo
end;


---

Юрий Зотов   (2006-01-23 14:11:00) [3]

> DimaBr   (23.01.06 10:18) [9]

Run-time модуль:

type
 TInternalObject = class(TPersistent)
 private
   FContainer: TComponent;
   FEvent1: TNotifyEvent;
   FEvent2: TNotifyEvent;
 protected
   function GetOwner: TPersistent; override;
   procedure AssignTo(Dest: TPersistent); override;
   procedure DoEvents; dynamic;
 public
   property Container: TComponent read FContainer;
   constructor Create(AContainer: TComponent);
 published
   property Event1: TNotifyEvent read FEvent1 write FEvent1;
   property Event2: TNotifyEvent read FEvent2 write FEvent2;
 end;

 TInternalObjectContainer = class(TComponent)
 private
   FInternalObject: TInternalObject;
   procedure SetInternalObject(const Value: TInternalObject);
   function GetEventList: TNotifyEvent;
   procedure SetEventList(const Value: TNotifyEvent);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property InternalObject: TInternalObject read FInternalObject write SetInternalObject;
   property EventList: TNotifyEvent read GetEventList write SetEventList stored False;
 end;

{ TInternalObject }

procedure TInternalObject.AssignTo(Dest: TPersistent);
begin
 if Dest is TInternalObject then
 with TInternalObject(Dest) do
 begin
   FEvent1 := Self.FEvent1;
   FEvent2 := Self.FEvent2;
   DoEvents
 end
 else
   inherited
end;

constructor TInternalObject.Create(AContainer: TComponent);
begin
 inherited Create;
 FContainer := AContainer
end;

procedure TInternalObject.DoEvents;
begin
 if Assigned(FEvent1) then FEvent1(Self);
 if Assigned(FEvent2) then FEvent2(Self)
end;

function TInternalObject.GetOwner: TPersistent;
begin
 Result := FContainer
end;

{ TInternalObjectContainer }

constructor TInternalObjectContainer.Create(AOwner: TComponent);
begin
 inherited;
 FInternalObject := TInternalObject.Create(Self)
end;

destructor TInternalObjectContainer.Destroy;
begin
 FInternalObject.Free;
 inherited
end;

function TInternalObjectContainer.GetEventList: TNotifyEvent;
begin
 Result := nil
end;

procedure TInternalObjectContainer.SetEventList(const Value: TNotifyEvent);
begin
 // Do nothing
end;

procedure TInternalObjectContainer.SetInternalObject(const Value: TInternalObject);
begin
 FInternalObject.Assign(Value)
end;

Design-time модуль:

type
 TEventListProperty = class(TPropertyEditor)
 protected
   function GetInternalObject: TPersistent; virtual;
 public
   function GetName: string; override;
   function GetValue: string; override;
   function GetAttributes: TPropertyAttributes; override;
   procedure GetProperties(Proc: TGetPropProc); override;
 end;

procedure Register;
begin
 RegisterComponents('YzExamples', [TInternalObjectContainer]);
 RegisterPropertyEditor(TypeInfo(TNotifyEvent), TInternalObjectContainer, 'EventList', TEventListProperty)
end;

{ TEventListProperty }

function TEventListProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paSubProperties, paReadOnly, paVolatileSubProperties]
end;

function TEventListProperty.GetInternalObject: TPersistent;
begin
 Result := TInternalObjectContainer(GetComponent(0)).InternalObject
end;

function TEventListProperty.GetName: string;
begin
 Result := 'InternalObject'
end;

type
 TFriendMethodProperty = class(TMethodProperty);

procedure TEventListProperty.GetProperties(Proc: TGetPropProc);
var
 EventCount, i: integer;
 EventList: PPropList;
 EventEditor: TMethodProperty;
begin
 EventCount := GetPropList(GetInternalObject.ClassInfo, tkMethods, nil);
 if EventCount > 0 then
 begin
   GetMem(EventList, EventCount * SizeOf(PPropInfo));
   try
     GetPropList(GetInternalObject.ClassInfo, tkMethods, EventList);
     for i := 0 to EventCount - 1 do
     begin
       EventEditor := TMethodProperty.Create(Designer, 1);
       with TFriendMethodProperty(EventEditor) do
       begin
         SetPropEntry(0, GetInternalObject, EventList[i]);
         Initialize;
         if ValueAvailable then
           Proc(EventEditor as IProperty)
       end
     end
   finally
     FreeMem(EventList, EventCount * SizeOf(PPropInfo))
   end
 end
end;

function TEventListProperty.GetValue: string;
begin
 Result := '(' + GetInternalObject.ClassName + ')'
end;


---

Anatoly Podgoretsky   (2006-01-23 13:54:00) [4]

DimaBr   (20.01.06 13:49)  
Событие это простое свойство, поэтому там негде взяться плюсику.

---

vuk   (2006-01-23 13:44:00) [5]

>Если работает Ctrl + X, Ctrl + V
А, Вы об этом... Ну да, есть такой баг в среде. Правда, не помню, чтобы он когда-либо мешал.

---

DimaBr   (2006-01-23 10:18:00) [6]

> vuk ©

Если работает Ctrl + X, Ctrl + V, то хотелось бы увидеть реализацию события вложенного компонента.

> Юрий Зотов ©

Я понимаю, что для Вас нет ничего сложного в написании компонентов, однако не у всех семь пядей во лбу. Как реализовать редактор свойства при Dbl клике которого создаётся метод в коде редактора. Помогите пожалуйста.

---

vuk   (2006-01-20 22:10:00) [7]

>К сожалению Delphi не дружит с событиями субкомпонентов
В смысле? У меня почему-то дружит...

---

jack128   (2006-01-20 16:58:00) [8]

Блин, я же тоже спрашивал на эту тему. Совсем старый стал.. :-))) . Ну тогда только [2]

---

DimaBr   (2006-01-20 16:25:00) [9]

To > jack128 ©
К сожалению Delphi не дружит с событиями субкомпонентов, это я уже спрашивал с пол года назад.

---

Юрий Зотов   (2006-01-20 15:41:00) [10]

> DimaBr   (20.01.06 15:17) [3]
> примерчик по написанию редактора свойства для события.

Он не нужен. События - это точно такие же свойства, как и все остальные. И их редакторы пишутся точно так же, как и все остальные. Примеров полно.

---

jack128   (2006-01-20 15:28:00) [11]

DimaBr   (20.01.06 15:17) [3]
Мне нужен TPersistent чтобы в инспекторе разворачивался
TComponent тоже может разворачиваться. см SetSubComponent

---

DimaBr   (2006-01-20 15:17:00) [12]

To  > Rouse_ ©
Мне нужен TPersistent чтобы в инспекторе разворачивался(как Font например).

To > Юрий Зотов ©
Можно небольшой примерчик по написанию редактора свойства для события.

---

Юрий Зотов   (2006-01-20 13:57:00) [13]

Вводим в компонент несохраняемое событие любого типа, а для него пишем обычный редактор свойства.

---

Rouse_   (2006-01-20 13:56:00) [14]

Наследуйся от TComponent, тогда он будет виден у тебя в закладке Events

---

Наверх