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
|
{ Source provided for Free Pascal Bug Report 2886 }
{ Submitted by "Mattias Gaertner" on 2004-01-08 }
{ e-mail: mattias@freepascal.org }
program WrongRTTIParams;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, TypInfo;
type
TAnEvent = procedure(Sender: TObject) of object;
TMyClass = class(TPersistent)
private
FMyEvent: TAnEvent;
public
procedure ShowRTTI;
published
property MyEvent: TAnEvent read FMyEvent write FMyEvent;
end;
{ TMyClass }
procedure TMyClass.ShowRTTI;
var
TypeData: PTypeData;
ParamCount: Integer;
Offset: Integer;
Len: Integer;
CurParamName: string;
CurTypeIdentifier: string;
i: Integer;
begin
TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType);
ParamCount:=TypeData^.ParamCount;
Offset:=0;
i:=0;
// for i:=0 to ParamCount-1 do begin
// SizeOf(TParamFlags) is 4, but the data is only 1 byte
Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags)
inc(Offset,Len);
// read ParamName
Len:=ord(TypeData^.ParamList[Offset]);
SetLength(CurParamName,Len);
if Len>0 then
Move(TypeData^.ParamList[Offset+1],CurParamName[1],Len);
inc(Offset,Len+1);
// read ParamType
Len:=ord(TypeData^.ParamList[Offset]);
SetLength(CurTypeIdentifier,Len);
if CurTypeIdentifier<>'' then
Move(TypeData^.ParamList[Offset+1],CurTypeIdentifier[1],Len);
inc(Offset,Len+1);
writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier);
if (CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject') then
begin
writeln('ERROR!');
halt(1);
end;
// end;
end;
var
MyClass: TMyClass;
begin
MyClass:=TMyClass.Create;
MyClass.ShowRTTI;
end.
|
