Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Компоненты";
Текущий архив: 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.039 c
2-1153253039
FifteenTen
2006-07-19 00:03
2006.08.20
Как в проводнике


2-1154502870
Ironman83
2006-08-02 11:14
2006.08.20
Цвет ячеек в сетке.


2-1154347870
just a girl
2006-07-31 16:11
2006.08.20
видимость формы


15-1153719008
Ega23
2006-07-24 09:30
2006.08.20
С Днём рождения! 23 июля


1-1152112966
oleggar
2006-07-05 19:22
2006.08.20
поисковик в Делфи





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский