根据窗体名称动态创建窗体

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, DB, ADODB;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    BitBtn1: TBitBtn;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  {---留意此处-------}
  TFrmName= ^MFrmName;
  MFrmName = record
  FType: string;
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}
{---留意这里----}
const  //也就是说要预存了下面这两个数组才可以很好的实现该功能
  ArrFormClass : array[0..1] of TFormClass=(TFrmHumanResource,TFrmFinance);
  ArrClassName : array[0..1] of String=('FrmHumanResource','FrmFinance');


function CreateForm(const AnyForm:TFormClass):TForm;
begin
  Result := AnyForm.Create(Application);
  Result.Showmodal;{模式显示}
end;


function GetIndex(sStr : String) : integer;
var
  i :integer;
begin
  result := -1 ;

  for i := low(ArrClassName) to high(ArrClassName) do
    if sStr = ArrClassName[i] then
    begin
      result := i ;
      exit;
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
p:TFrmName;
Nodea,Nodeb:TTreeNode;
begin
{------------------------------建树----------------------}
with adoquery1 do begin
   Nodea:=TreeView1.Items.AddChild(nil,adoquery1.FieldValues['FrmCaption']);
   while not eof do begin
    new(p);
    Nodeb:=TreeView1.Items.AddChild(Nodea,adoquery1.FieldValues['FrmCaption']);
    p^.FType:=adoquery1.FieldValues['FrmName'];
    Nodeb.Data:=p;
    next;
   end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var  
I:Integer;
begin
{--释放TreeView的data}
for   I := 0   to TreeView1.Items.Count -1   do
  if  Assigned(TreeView1.Items[I].Data) then begin
     Dispose(TFrmName(TreeView1.Items[I].Data));
     TreeView1.Items[I].Data   :=   nil;
  end;
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
var
  iIndex : integer;

begin
   if   Assigned(TreeView1.Selected.Data)   then
   begin
     iIndex := GetIndex(TFrmName(TreeView1.Selected.Data).FType);
     if iIndex = -1 then exit;
     CreateForm(ArrFormClass[iIndex]);
   end;
end;
end.
{注:示例的窗体是动态创建的,请安实制需要修改,另本例是经过测试才发代码的}