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

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

图片：

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

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

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

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

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

---Unit1开始----

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     Button1: TButton;
12     procedure Button1Click(Sender: TObject);
13   private
14     procedure MyCreateForm(sFormClass: string);
15     { Private declarations }
16   public
17     { Public declarations }
18   end;
19 
20 var
21   Form1: TForm1;
22 
23 implementation
24 
25 {$R *.dfm}
26 
27 procedure TForm1.Button1Click(Sender: TObject);
28 begin
29   MyCreateForm('TForm2');
30 end;
31 
32 procedure TForm1.MyCreateForm(sFormClass: string);
33 var
34   TvFrmClass: TFormClass;//相当于这个(AFormClass: T.....FormClass;) //这个注释是写给某个人看的，请忽略
35   vForm:TForm; //这个相当于这个(AForm: T.....Form; )  //这个注释是写给某个人看的，请忽略
36 begin
37   TvFrmClass:=TFormClass(GetClass(sFormClass));
38   if TvFrmClass<>nil then
39     vForm:=TvFrmClass.Create(self);
40   //vForm:=TFormClass(GetClass(sFormClass)).Create(self);// 和上面几句是一样效果，但是上面的写法不会报错//当要创建的窗体没有注册时，这句会报错的
41   if vForm<>nil then
42     vForm.Show;
43 end;
44 
45 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开始

 1 unit Unit2;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs;
 8 
 9 type
10   TForm2 = class(TForm)
11     procedure FormClose(Sender: TObject; var Action: TCloseAction);
12   private
13     { Private declarations }
14   public
15     { Public declarations }
16   end;
17 
18 var
19   Form2: TForm2;
20 
21 implementation
22 
23 {$R *.dfm}
24 procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
25 begin
26   Action:=caFree;
27 end;
28 
29 initialization
30   RegisterClass(TForm2);
31 finalization
32   UnRegisterClass(TForm2);
33 end.

在Unit2单元最下面看的到

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

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

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

--------Unit2结束

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

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

---Form1开始

 1 object Form1: TForm1
 2   Left = 633
 3   Top = 333
 4   Width = 341
 5   Height = 281
 6   Caption = 'Form1'
 7   Color = clBtnFace
 8   Font.Charset = DEFAULT_CHARSET
 9   Font.Color = clWindowText
10   Font.Height = -11
11   Font.Name = 'MS Sans Serif'
12   Font.Style = []
13   OldCreateOrder = False
14   PixelsPerInch = 96
15   TextHeight = 13
16   object Button1: TButton
17     Left = 112
18     Top = 80
19     Width = 75
20     Height = 25
21     Caption = 'Button1'
22     TabOrder = 0
23     OnClick = Button1Click
24   end
25 end

----Form1结束

----Form2开始

 1 object Form2: TForm2
 2   Left = 588
 3   Top = 370
 4   Width = 439
 5   Height = 315
 6   Caption = 'Form2'
 7   Color = clBtnFace
 8   Font.Charset = DEFAULT_CHARSET
 9   Font.Color = clWindowText
10   Font.Height = -11
11   Font.Name = 'MS Sans Serif'
12   Font.Style = []
13   OldCreateOrder = False
14   OnClose = FormClose
15   PixelsPerInch = 96
16   TextHeight = 13
17 end

---Form2结束

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