mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-15 22:42:36 +02:00
85 lines
2.0 KiB
ObjectPascal
85 lines
2.0 KiB
ObjectPascal
program example6;
|
|
|
|
{ This program demonstrates the GetMethodProp function }
|
|
|
|
{$mode objfpc}
|
|
|
|
uses rttiobj,typinfo,sysutils;
|
|
|
|
Type
|
|
TNotifyObject = Class(TObject)
|
|
Procedure Notification1(Sender : TObject);
|
|
Procedure Notification2(Sender : TObject);
|
|
end;
|
|
|
|
Procedure TNotifyObject.Notification1(Sender : TObject);
|
|
|
|
begin
|
|
Write('Received notification 1 of object with class: ');
|
|
Writeln(Sender.ClassName);
|
|
end;
|
|
|
|
Procedure TNotifyObject.Notification2(Sender : TObject);
|
|
|
|
begin
|
|
Write('Received notification 2 of object with class: ');
|
|
Writeln(Sender.ClassName);
|
|
end;
|
|
|
|
Var
|
|
O : TMyTestObject;
|
|
PI : PPropInfo;
|
|
NO : TNotifyObject;
|
|
M : TMethod;
|
|
|
|
Procedure PrintMethod (Const M : TMethod);
|
|
|
|
begin
|
|
If (M.Data=Pointer(NO)) Then
|
|
If (M.Code=Pointer(@TNotifyObject.Notification1)) then
|
|
Writeln('Notification1')
|
|
else If (M.Code=Pointer(@TNotifyObject.Notification2)) then
|
|
Writeln('Notification2')
|
|
else
|
|
begin
|
|
Write('Unknown method adress (data:');
|
|
Write(hexStr(Longint(M.data),8));
|
|
Writeln(',code:',hexstr(Longint(M.Code),8),')');
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
O:=TMyTestObject.Create;
|
|
NO:=TNotifyObject.Create;
|
|
O.NotifyEvent:=@NO.Notification1;
|
|
PI:=GetPropInfo(O,'NotifyEvent');
|
|
Writeln('Method property : ');
|
|
Write('Notifying : ');
|
|
O.Notify;
|
|
Write('Get (name) : ');
|
|
M:=GetMethodProp(O,'NotifyEvent');
|
|
PrintMethod(M);
|
|
Write('Notifying : ');
|
|
O.Notify;
|
|
Write('Get (propinfo) : ');
|
|
M:=GetMethodProp(O,PI);
|
|
PrintMethod(M);
|
|
M.Data:=No;
|
|
M.Code:=Pointer(@NO.Notification2);
|
|
SetMethodProp(O,'NotifyEvent',M);
|
|
Write('Set (name,Notification2) : ');
|
|
M:=GetMethodProp(O,PI);
|
|
PrintMethod(M);
|
|
Write('Notifying : ');
|
|
O.Notify;
|
|
Write('Set (propinfo,Notification1) : ');
|
|
M.Data:=No;
|
|
M.Code:=Pointer(@NO.Notification1);
|
|
SetMethodProp(O,PI,M);
|
|
M:=GetMethodProp(O,PI);
|
|
PrintMethod(M);
|
|
Write('Notifying : ');
|
|
O.Notify;
|
|
O.Free;
|
|
end. |