Am 27.07.2019 um 19:02 schrieb fredvs:
Imho, it seems that in your code "if not (pfHidden in flags) then" was
placed one "end;" too far.
That's what I meant in the mail you replied to.
Am 27.07.2019 um 19:07 schrieb fredvs:
Sven, did you try a simple code, it seems that "$self" first parameter is
always added into params list, even if you filter it with "pfHidden" flag.
This example works as intended:
=== code begin ===
program tmethodinfo;
{$mode objfpc}{$H+}
uses
typinfo, classes, sysutils;
{$M+}
type
TMyMethod1 = procedure(const aSender: TObject) of object;
TMyMethod2 = function(var aArg: LongInt; aArr: array of LongInt):
String of object;
{$M-}
function FuncToString(aTI: PTypeInfo): String;
var
td: PTypeData;
pb: PByte;
args: TStrings;
flags: TParamFlags;
res, s, prefix, argname, argtype: String;
i: SizeInt;
begin
if aTI^.Kind <> tkMethod then
raise Exception.Create('Method type information expected');
td := GetTypeData(aTI);
args := TStringList.Create;
try
args.Delimiter := ';';
args.QuoteChar := #0;
pb := @td^.ParamList;
for i := 0 to td^.ParamCount - 1 do begin
flags := TParamFlags(PWord(pb)^);
Inc(pb, SizeOf(TParamFlags));
argname := PShortString(pb)^;
Inc(pb, SizeOf(Byte) + Length(argname));
argtype := PShortString(pb)^;
Inc(pb, SizeOf(Byte) + Length(argtype));
if pfHidden in flags then
Continue;
prefix := '';
if pfConst in flags then
prefix := 'const'
else if pfConstRef in flags then
prefix := 'constref'
else if pfVar in flags then
prefix := 'var'
else if pfOut in flags then
prefix := 'out';
s := '';
if prefix <> '' then
s := prefix + ' ';
s := s + argname + ': ';
if pfArray in flags then
s := s + 'array of ';
s := s + argtype;
args.Add(s);
end;
if td^.MethodKind in [mkFunction, mkClassFunction] then
res := PShortString(pb)^
else
res := '';
Result := '';
if td^.MethodKind in [mkClassFunction, mkClassProcedure,
mkClassConstructor, mkClassDestructor] then
Result := 'class ';
if td^.MethodKind in [mkClassFunction, mkFunction] then
Result := Result + 'function '
else if td^.MethodKind in [mkClassProcedure, mkProcedure] then
Result := Result + 'procedure '
else if td^.MethodKind in [mkConstructor, mkClassConstructor] then
Result := Result + 'constructor '
else if td^.MethodKind in [mkDestructor, mkClassDestructor] then
Result := Result + 'destructor '
else
Result := Result + 'unknown ';
Result := Result + aTI^.Name + ' ';
if args.Count > 0 then
Result := Result + '(' + args.DelimitedText + ')';
if res <> '' then
Result := Result + ': ' + res;
finally
args.Free;
end;
end;
begin
Writeln(FuncToString(TypeInfo(TMyMethod1)));
Writeln(FuncToString(TypeInfo(TMyMethod2)));
end.
=== code end ===
And will print the following:
=== code begin ===
procedure TMyMethod1 ( const aSender: TObject )
function TMyMethod2 ( var aArg: LongInt ; aArr: array of LongInt ):
AnsiString
=== code end ===
So it definitely works, now you only need to figure out the problem in
your code.
Regards,
Sven
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
