1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
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:=TMethod(@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:=TMethod(@NO.Notification1);
SetMethodProp(O,PI,M);
M:=GetMethodProp(O,PI);
PrintMethod(M);
Write('Notifying : ');
O.Notify;
O.Free;
end.
|
