//控件单元。 {* 单元说明: 创建模式窗口,和非模式窗口的类,保证非模式窗口只创建一次。 作者 : 笔名:易 一 英文名:yeeyee E-Mail : jane1437@163.com 创建时间: 2005年5月20日 及最后修改时间: 修改人修改时间及: 修改说明: 版权声明: 版权所有,转载请注明本人邮箱和笔名。 *} unit ShowFormClass; interface uses SysUtils, Classes,Dialogs, Forms; type TShowFormClass = class(TComponent) private { Private declarations } //保存要创建的窗体的类名 FFrmName:string; //判断窗体是否存在。 function IsFormExist:boolean; //得到窗体。 function GetExistForm:TForm; //创建一个类 function CreateAClass(const AClassName: string): TForm; protected { Protected declarations } public { Public declarations } constructor Create(AOwner: TComponent); virtual; destructor Destroy; override; //创建并显示窗体。模式窗体。 procedure ShowModalForm(const AStrForm:string);overload; procedure ShowModalForm(AFormClass:TFormClass);overload; //创建并显示窗体。非模式窗体。 procedure ShowModalLessForm(const AStrForm:string);overload; procedure ShowModalLessForm(AFormClass:TFormClass);overload; published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents(''''Yeeyee'''', [TShowFormClass]); end;
constructor TShowFormClass.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TShowFormClass.Destroy; begin inherited Destroy; end; function TShowFormClass.GetExistForm:TForm; var i:integer; begin for i := 0 to (Application.ComponentCount - 1) do begin if (Application.Components[i] is TForm) then begin //注意,关键判断这个类型名称是否存在。 if (application.Components[i] as TForm).ClassType.ClassName = FFrmName then begin Result:=(application.Components[i] as TForm); exit; end end; end; end; function TShowFormClass.IsFormExist:boolean; var i:integer; begin Result:=False; for i := 0 to (Application.ComponentCount - 1) do begin if (Application.Components[i] is TForm) then begin //注意,关键判断这个类型名称是否存在。 if (application.Components[i] as TForm).ClassType.ClassName = FFrmName then begin Result:=True; exit; end end; end; end; //创建一个类 function TShowFormClass.CreateAClass(const AClassName: string): TForm; var LFormClass : TFormClass; LForm: TForm; begin LFormClass := TFormClass(FindClass(AClassName)); LForm := LFormClass.Create(Application); Result := LForm; end; //创建并显示窗体。模式窗体。传入字符串。 procedure TShowFormClass.ShowModalForm(const AStrForm:string); var LForm: TForm; begin FFrmName:=AStrForm; LForm := CreateAClass(FFrmName); try LForm.ShowModal; finally LForm.Free; end; end; //创建并显示窗体。模式窗体。传入类的引用。 procedure TShowFormClass.ShowModalForm(AFormClass:TFormClass); begin with AFormClass.Create(Application) do begin try ShowModal; finally Free; end; end; end; //创建并显示窗体。模式窗体。传入字符串。 procedure TShowFormClass.ShowModalLessForm(const AStrForm:string); var LForm: TForm; begin FFrmName:=AStrForm; //窗体不存在,则创建。 if not IsFormExist then begin LForm := CreateAClass(FFrmName); LForm.Show; end else begin //存在,则得到窗体。带到最前头。 LForm:=GetExistForm; LForm.BringToFront; end; end; //创建并显示窗体。模式窗体。传入类的应用。 procedure TShowFormClass.ShowModalLessForm(AFormClass:TFormClass); var LForm: TForm; begin FFrmName:=AFormClass.ClassName; //窗体不存在,则创建。 if not IsFormExist then begin LForm := CreateAClass(FFrmName); LForm.Show; end else begin //存在,则得到窗体。带到最前头。 LForm:=GetExistForm; LForm.BringToFront; end; end; end.
//调用单元 procedure TMainForm.mmiAreaClick(Sender: TObject); begin // YShowFormClass.ShowModalForm(TFormArea); end;
(* procedure TMainForm.mmiAreaClick(Sender: TObject); begin // YShowFormClass.ShowModalForm(''''TFormArea''''); end; initialization begin RegisterClasses([TAboutBox,TFormArea]); end; finalization begin UnRegisterClasses([TAboutBox,TFormArea]); end; *)
[Delphi程序]Delphi下用WindowsAPI创建窗体
|