Форум: "Компоненты";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Вниз

Вложенные события   Найти похожие ветки 

← →
DimaBr   (2006-01-20 13:49) [0]

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

---

← →
Rouse_ ©   (2006-01-20 13:56) [1]

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

---

← →
Юрий Зотов ©   (2006-01-20 13:57) [2]

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

---

← →
DimaBr   (2006-01-20 15:17) [3]

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

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

---

← →
jack128 ©   (2006-01-20 15:28) [4]

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

---

← →
Юрий Зотов ©   (2006-01-20 15:41) [5]

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

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

---

← →
DimaBr   (2006-01-20 16:25) [6]

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

---

← →
jack128 ©   (2006-01-20 16:58) [7]

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

---

← →
vuk ©   (2006-01-20 22:10) [8]

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

---

← →
DimaBr   (2006-01-23 10:18) [9]

> vuk ©

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

> Юрий Зотов ©

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

---

← →
vuk ©   (2006-01-23 13:44) [10]

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

---

← →
Anatoly Podgoretsky ©   (2006-01-23 13:54) [11]

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

---

← →
Юрий Зотов ©   (2006-01-23 14:11) [12]

> 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;


---

← →
Юрий Зотов ©   (2006-01-23 14:20) [13]

Пояснение.

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

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


---

← →
DimaBr   (2006-01-23 14:40) [14]

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

---

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

Форум: "Компоненты";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.051 c