события

← →
demonnnn (2006-09-12 08:12) [0]

Добрый день эксперты есть такая проблема
Мне хотелось бы отобразить все свойства и события в инспекторе вложенного компонента

← →
DimaBr (2006-09-12 08:56) [1]

надеюсь что Юрий будет не против, выкладываю его творчество.

Юрий Зотов © (23.01.06 14:11) [12]

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;

← →
demonnnn (2006-09-12 09:18) [2]

не совсем то я имею ввиду когда
есть главный компонент Twincomtrol а на нем
у тебя в компоненте есть Fpanel
когда в published указываешь его
property panel:Tpanel read fpanel write fpanel;
предворительно конечно создав в конструкторе
то в инспекторе отоброжаются только свойства а события этой панели не отображаются

← →
Teenager © (2006-10-09 19:51) [3]

читаю - не удержался... :)

чувак... вот у мя не было учебника.. поизучал пару компонент - сам понял.

идея в том, чтобы создать новые события в своем компоненте, которые будут присваивать выставляемые обработчики событий отому Fpanel ...

надеюсь, понятно? :)

> demonnnn (12.09.06 09:18) [2]

> события этой панели не отображаются

> GetPropList(GetInternalObject.ClassInfo, tkMethods, EventList);

> не совсем то я имею ввиду

???

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