blob: 919bf38bb6aef5a75dc15a617fa91a82c72f4969 (
plain)
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
|
{$mode objfpc}{$H+}
uses classes,typinfo;
type
TA = class(TPersistent)
private
FOnTest: TNotifyEvent;
procedure SetOnTest(value: TNotifyEvent);
public
procedure CallTest;
published
property OnTest: TNotifyEvent read FOnTest Write SetOnTest;
end;
TB = class
public
procedure Test(Sender: TObject);
end;
procedure TA.SetOnTest(value: TNotifyEvent);
begin
FOnTest := Value
end;
procedure TA.CallTest;
begin
if Assigned(FOnTest) then
OnTest(self)
else
WriteLn('OnTest no set');
end;
procedure TB.Test(Sender: TObject);
begin
WriteLn('Test Called');
end;
var
A: TA;
B: TB;
PropInfo: PPropInfo;
Method: TMethod;
begin
A := TA.Create;
B := TB.Create;
Method:=TMethod(@B.Test);
PropInfo:=GetPropInfo(A.ClassInfo, 'OnTest');
if Assigned(PropInfo) then begin
SetMethodProp(A, PropInfo, Method);
WriteLn('Testing SetMethodProp method');
A.CallTest;
end
else begin
WriteLn('PropInfo for ''OnTest'' not found');
Halt(1);
end;
end.
|
