From 7ad3a0f12c3518e23011165c28a9b49f6b70e051 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Mon, 18 Dec 2017 20:42:29 +0000
Subject: [PATCH] + add implementation class for parameters of methods that
 belong to a VMT-based type

git-svn-id: trunk@37758 -
---
 packages/rtl-objpas/src/inc/rtti.pp | 50 +++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)

diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index 21cd73b030..718ca81467 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/packages/rtl-objpas/src/inc/rtti.pp
@@ -510,6 +510,18 @@ type
     function GetIntfType: TInterfaceType; override;
   end;
 
+  TRttiVmtMethodParameter = class(TRttiParameter)
+  private
+    FVmtMethodParam: PVmtMethodParam;
+  protected
+    function GetHandle: Pointer; override;
+    function GetName: String; override;
+    function GetFlags: TParamFlags; override;
+    function GetParamType: TRttiType; override;
+  public
+    constructor Create(AVmtMethodParam: PVmtMethodParam);
+  end;
+
 resourcestring
   SErrUnableToGetValueForType = 'Unable to get value for type %s';
   SErrUnableToSetValueForType = 'Unable to set value for type %s';
@@ -1075,6 +1087,44 @@ begin
   Result := itRaw;
 end;
 
+{ TRttiVmtMethodParameter }
+
+function TRttiVmtMethodParameter.GetHandle: Pointer;
+begin
+  Result := FVmtMethodParam;
+end;
+
+function TRttiVmtMethodParameter.GetName: String;
+begin
+  Result := FVmtMethodParam^.Name;
+end;
+
+function TRttiVmtMethodParameter.GetFlags: TParamFlags;
+begin
+  Result := FVmtMethodParam^.Flags;
+end;
+
+function TRttiVmtMethodParameter.GetParamType: TRttiType;
+var
+  context: TRttiContext;
+begin
+  if not Assigned(FVmtMethodParam^.ParamType) then
+    Exit(Nil);
+
+  context := TRttiContext.Create;
+  try
+    Result := context.GetType(FVmtMethodParam^.ParamType^);
+  finally
+    context.Free;
+  end;
+end;
+
+constructor TRttiVmtMethodParameter.Create(AVmtMethodParam: PVmtMethodParam);
+begin
+  inherited Create;
+  FVmtMethodParam := AVmtMethodParam;
+end;
+
 { TRttiFloatType }
 
 function TRttiFloatType.GetFloatType: TFloatType;