delphi 能否通过RTTI 实现根据名称动态创建类的实例

Question

我的一个MyForm 是继承自 TForm，把它作为一个参数传给一个过程 procedure xxxxx(Frm: TFrom);  // 这个虚参的声明不允许修改
begin
  // 想根据Frm.ClassName 创建类的实例，能做到吗？
end;

Answer 1

你完全可以在Frm的类中实现一个CreateNew方法来做这件事情啊

Answer 2

这个函数也不是干这个的呀。我类似MyForm这样的类大约有几十个，你不可能让我再去修改它。

Answer 3

procedure xxxxx(Frm: TFrom);  // 这个虚参的声明不允许修改
begin
  // 想根据Frm.ClassName 创建类的实例，能做到吗？
  TFormClass(GetClass(Frm.ClassName)).Create(OwnerOfTheForm);
end;

Answer 4

前提，为了让GetClass或者FindClass能够返回正确的类VMT指针，
你必须调用RegisterClass注册它们，比如RegisterCalsses([TForm1, TForm2, TOtherForm]);

Answer 5

pazee兄是不是这样，瞎弄的unit Unit19;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ActnMan, ActnCtrls, ExtCtrls, ActnList, StdCtrls;type
  TMainForm = class(TForm)
    ActionManager1: TActionManager;
    Panel1: TPanel;
    ActionToolBar1: TActionToolBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  MainForm: TMainForm;implementationuses Unit20;
{$R *.dfm}procedure  CreateFormInstance(var Form);
begin
  TForm(Form) := TFormClass(TForm(Form).ClassType).Create(Application);
  TForm(Form).Show;
end;procedure TMainForm.Button1Click(Sender: TObject);
begin
  CreateFormInstance(MainForm1);
end;end.

Answer 6

用RegisterClasses把她们注册一遍就行了,
不过我觉得还是用class of class来实现比较好

Answer 7

//假定所有工作窗口都继承自TWorkspace, 
// TWorkspaceClass = class of TWorkspace;
// TWorkManger 为工作窗口管理类
function TWorkManager.NewWorkspace(AWorkspaceClass: TWorkspaceClass): TWorkspace;
begin
  Result := AWorkspaceClass.Create(Self);
end;

Answer 8

老达摩为了帮助广大网友，它的Unit已经去到Unit20了，哈哈哈

Answer 9

谢谢 alphax(多喝了三五杯) 和  xzgyb(老达摩) ，
老达摩很久看不到了，嘿嘿。我看过这些帮助了，目前也是这么写的，  RegisterClass(TFrmPort);
  FindMDIChildWindowEx(TFrmPort, true);
  UnregisterCalss(TFrmPort);  // 看了一下RegisterClass的函数代码，发现它会检查是否已经注册了，不会重复注册，除了多些内存开销，不写也很方便。..........
function FindMDIChildWindowEx(ClsFrm: TPersistentClass; bRestore: boolean):boolean;
begin
  ...
    if (frm = nil) then
      frm:= TFormClass(GetClass(ClsFrm.ClassName)).Create(self);
  ...
end;
但老觉得不踏实，你们这些高人说这么做对，那就没错了。 westfly(西翔) 你的方法怎么说？

Answer 10

改成这样了，  FindMDIChildWindowEx(TFrmPort, true);..........
function FindMDIChildWindowEx(ClsFrm: TPersistentClass; bRestore: boolean):boolean;
begin
  ...
  if (frm = nil) then begin
    RegisterClass(TFrmPort);     //
    frm:= TFormClass(GetClass(ClsFrm.ClassName)).Create(self);
    UnregisterCalss(TFrmPort);   //
  end;
  ...
end;

Answer 11

是这样了  FindMDIChildWindowEx(TFrmPort, true);..........
function FindMDIChildWindowEx(ClsFrm: TPersistentClass; bRestore: boolean):boolean;
begin
  ...
  if (frm = nil) then begin
    RegisterClass(ClsFrm);     //
    frm:= TFormClass(GetClass(ClsFrm.ClassName)).Create(self);
    UnregisterCalss(ClsFrm);   //
  end;
  ...

Answer 12

既然你传递的是Class而不是ClassName，而且你知道肯定是TFormClass，那何须这样？直接这样好了function FindMDIChildWindowEx(ClsFrm: TFormClass; bRestore: boolean):boolean;
begin
  ...
  if (frm = nil) then begin
    frm := ClsFrm.Create(Self);
  ...

Answer 13

谢谢alphax提醒，我的完全错误
同意alphax,既然知道传TFormClass了，直接建就可了
另外耙兄如果根据类名创建也可这样，不一定要用RegisterClassunit Unit19;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ActnMan, ActnCtrls, ExtCtrls, ActnList, StdCtrls;type
  TMainForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  MainForm: TMainForm;implementationuses Unit20;
{$R *.dfm}const
  FormClasses: array[0..1] of TFormClass = (TMainForm, TForm1);
procedure  CreateFormInstance(const FormClassName: string; var Form);
var
  I: Integer;
begin
  for i := Low(FormClasses) to High(FormClasses) do
    if FormClasses[I].ClassName = FormClassName then
    begin
     TForm(Form) := FormClasses[I].Create(Application);
     TForm(Form).Show;
     break;
    end;
end;procedure TMainForm.Button1Click(Sender: TObject);
begin
  Form1 := nil;
  CreateFormInstance('TForm1', Form1);
end;end.

Answer 14

他妈的CSDN，写了半天 忘了复制，一提交 失败，全没了。

Answer 15

我记得以前就关于线程的资源问题受教过pazee哥，至今受益匪浅

Answer 16

alphax说的是我吗？我有那能耐？