Delphi用窗体类名创建窗体(需要用到GetClass)

-----------开发环境 Delphi7

图片：

-------------------------------

这个适合对Delphi有一定了解的人看，因为我不会细说步骤的：

新建一个工程后，Delphi会自动创建立一个Form1;我们再添加一个Form2；设置Form2不要自动创建！

--------------------------------

--Unit开始-------

---Unit1开始----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure MyCreateForm(sFormClass: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyCreateForm('TForm2');
end;

procedure TForm1.MyCreateForm(sFormClass: string);
var
  TvFrmClass: TFormClass;//相当于这个(AFormClass: T.....FormClass;) //这个注释是写给某个人看的，请忽略
  vForm:TForm; //这个相当于这个(AForm: T.....Form; )  //这个注释是写给某个人看的，请忽略
begin
  TvFrmClass:=TFormClass(GetClass(sFormClass));
  if TvFrmClass<>nil then
    vForm:=TvFrmClass.Create(self);
  //vForm:=TFormClass(GetClass(sFormClass)).Create(self);// 和上面几句是一样效果，但是上面的写法不会报错//当要创建的窗体没有注册时，这句会报错的
  if vForm<>nil then
    vForm.Show;
end;

end.

GetClass简述:

单元Classes中有这样的定义

function GetClass(const AClassName: string): TPersistentClass;
begin
RegGroups.Lock;
try
Result := RegGroups.GetClass(AClassName);
finally
RegGroups.Unlock;
end;
end;

RegGroups是什么，是这个TRegGroups类型的变量，是TRegGroups的一个实例赋值给了RegGroups；

RegGroups怎么创建的？

在加载Classes这个单元时创建的RegGroups

---RegGroups开始

initialization
AddModuleUnloadProc(ModuleUnload);
{$IFDEF MSWINDOWS}
GlobalNameSpace := TMultiReadExclusiveWriteSynchronizer.Create;
{$ENDIF}
{$IFDEF POSIX}
GlobalNameSpace := TSimpleRWSync.Create;
{$ENDIF}
RegGroups := TRegGroups.Create;//这里这里
IntConstList := TThreadList.Create;
GlobalFixupList := TThreadList.Create;

finalization
UnRegisterModuleClasses(HInstance);
GlobalNameSpace.BeginWrite;
FreeIntConstList;
RemoveFixupReferences(nil, '');
FreeAndNil(GlobalFixupList);
FreeAndNil(GlobalLists);
FreeAndNil(RegGroups);
GlobalNameSpace := nil;
RemoveModuleUnloadProc(ModuleUnload);
FreeAndNil(FindGlobalComponentProcs);

---RegGroups 结束

这个RegGroups 建立了，但问题是

GetClass的中的值怎么来的

在Unit2中的最下方有这么一句RegisterClass(TForm2)，这就是向RegGroups 添加一个TForm2,这样才能实现GetClass按类名获取到类

下面的这个一点点扩展，可以不管了，怕绕晕人！

{扩展：RegisterClass 和 GetClass实际操作的不是TRegGroups的实例，而是TRegGroup的实例，这个两个类的实例配合使用的 }

-----Unit1结束---------

-------Unit2开始

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm2 = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

initialization
  RegisterClass(TForm2);
finalization
  UnRegisterClass(TForm2);
end.

  在Unit2单元最下面看的到

29 initialization  //加载单元时执行
30   RegisterClass(TForm2);//注册这个TForm2
31 finalization//就叫卸载吧，卸载单元时执行
32   UnRegisterClass(TForm2);//卸载这个TForm2

这里的注册TForm2和卸载TForm2要成对出现，最好这样！

只有注册了，GetClass才能按类名称获取得到类，否则是获取不到。

--------Unit2结束

---Unit结束------

-------Form开始---

---Form1开始

object Form1: TForm1
  Left = 633
  Top = 333
  Width = 341
  Height = 281
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 112
    Top = 80
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end

----Form1结束

----Form2开始

object Form2: TForm2
  Left = 588
  Top = 370
  Width = 439
  Height = 315
  Caption = 'Form2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
end

---Form2结束

------Form结束----