|
@@ -23,6 +23,8 @@ type
|
|
{ TMyClass }
|
|
{ TMyClass }
|
|
|
|
|
|
procedure TMyClass.ShowRTTI;
|
|
procedure TMyClass.ShowRTTI;
|
|
|
|
+type
|
|
|
|
+ PParamFlags = ^TParamFlags;
|
|
var
|
|
var
|
|
TypeData: PTypeData;
|
|
TypeData: PTypeData;
|
|
ParamCount: Integer;
|
|
ParamCount: Integer;
|
|
@@ -30,6 +32,7 @@ var
|
|
Len: Integer;
|
|
Len: Integer;
|
|
CurParamName: string;
|
|
CurParamName: string;
|
|
CurTypeIdentifier: string;
|
|
CurTypeIdentifier: string;
|
|
|
|
+ CurFlags: TParamFlags;
|
|
i: Integer;
|
|
i: Integer;
|
|
begin
|
|
begin
|
|
TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType);
|
|
TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType);
|
|
@@ -39,6 +42,7 @@ begin
|
|
i:=0;
|
|
i:=0;
|
|
// for i:=0 to ParamCount-1 do begin
|
|
// for i:=0 to ParamCount-1 do begin
|
|
|
|
|
|
|
|
+ CurFlags := PParamFlags(@TypeData^.ParamList[0])^;
|
|
// SizeOf(TParamFlags) is 4, but the data is only 1 byte
|
|
// SizeOf(TParamFlags) is 4, but the data is only 1 byte
|
|
//Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags)
|
|
//Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags)
|
|
// Note by SB (2017-01-08): No longer true since typinfo uses packed sets
|
|
// Note by SB (2017-01-08): No longer true since typinfo uses packed sets
|
|
@@ -60,9 +64,9 @@ begin
|
|
inc(Offset,Len+1);
|
|
inc(Offset,Len+1);
|
|
|
|
|
|
writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier);
|
|
writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier);
|
|
- // Note by SB (2019-10-08): The first parameter is now the hidden $self
|
|
|
|
- if (CurParamName<>'$self') or (CurTypeIdentifier<>'Pointer') then
|
|
|
|
- //if (CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject') then
|
|
|
|
|
|
+ // Note by SB (2019-10-08): The first parameter might now be the hidden $self
|
|
|
|
+ if ((pfSelf in CurFlags) and ((CurParamName<>'$self') or (CurTypeIdentifier<>'Pointer'))) or
|
|
|
|
+ (not (pfSelf in CurFlags) and ((CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject'))) then
|
|
begin
|
|
begin
|
|
writeln('ERROR!');
|
|
writeln('ERROR!');
|
|
halt(1);
|
|
halt(1);
|