当先锋百科网

首页 1 2 3 4 5 6 7

昨天在看 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.

参考:Delphi2010强化的反射_敦格-CSDN博客_delphi 反射