昨天在看 Java Web 开发时有看到servlet 通过反射动态创建类,想到Delphi中能否实现。
环境 Win10 x64 , Delphi 10.4 需引用 System.Rtti ;
发现 private 下的 function GetXY:Integer 没有获取到,why? Rtti设计就这样?
unit untTest;
interface
uses
Classes,SysUtils,Dialogs;
type
TTestClass = class(TPersistent) //需继承TPersistent
private
FX:Integer;
FY:Integer;
FStr : string;
function GetXY:Integer;
public
function DoAdd(x,y: Integer):Integer;
procedure ShowMsgBox;
property X: Integer read FX write FX;
property Y: Integer read FY write FY;
property STR: string read FStr write FStr;
property XAY: Integer read GetXY;
end;
implementation
{ TTestClass }
function TTestClass.DoAdd(x, y: Integer): Integer;
begin
Result := x+y;
end;
function TTestClass.GetXY: Integer;
begin
Result := FX+FY;
end;
procedure TTestClass.ShowMsgBox;
begin
ShowMessage('Test Call');
end;
initialization
RegisterClass(TTestClass); //进行注册
finalization
unregisterClass(TTestClass);
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,System.Rtti,
untTest;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
lbl_method: TLabel;
edt_method: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
ref: TRttiContext;
procedure ReflectClass(AClass:TRttiInstanceType);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
t:TTestClass;
typ: TRttiType;
mthd: TRttiMethod;
value: TValue;
begin
// 使用 FindClass 查找创建类
t := FindClass('TTestClass').Create as TTestClass;
typ := Ref.GetType(TTestClass);
mthd := typ.GetMethod(edt_method.text);
value := mthd.Invoke(t,[1,2]);
ShowMessage(IntToStr(value.AsInteger));
t.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
typ: TRttiType;
begin
typ := Ref.GetType(TTestClass);
ReflectClass(typ.AsInstance);
end;
procedure TForm1.ReflectClass(AClass: TRttiInstanceType);
var
fields : TArray<TRttiField>;
field : TRttiField;
methods : TArray<TRttiMethod>;
method : TRttiMethod;
params : TArray<TRttiParameter>;
param : TRttiParameter;
props : TArray<TRttiProperty>;
prop: TRttiProperty;
s : string;
begin
memo1.Lines.Add(AClass.Name);
fields := AClass.GetFields;
for field in fields do
begin
memo1.Lines.Add(field.Name +' -- '+ field.FieldType.Name);
end;
methods := AClass.GetMethods();
for method in methods do
begin
params := method.GetParameters;
s := EmptyStr;
for param in params do
begin
s := s + Format('%s, ',[param.ToString]);
end;
s := Copy(s,1,Length(s)-2);
if method.ReturnType = nil then
s:= Format(' procedure %s(%s);',[method.Name,s])
else
s:= Format(' function %s(%s):%s;',[method.Name,s,method.ReturnType.Name]);
memo1.Lines.Add(s);
end;
props := AClass.GetProperties;
for prop in props do
begin
s := EmptyStr;
if (prop.IsReadable) and(not prop.IsWritable) then
s:= 'ReadOnly';
if(not prop.IsReadable) and (prop.IsWritable) then
s:= 'WriteOnly';
memo1.Lines.Add(Format(' %s:%s;%s',[prop.Name,prop.PropertyType.Name,s]));
end;
end;
end.