|
发表于 2020-9-1 08:30:01
|
显示全部楼层
[color=#FF0000]动态调用BPL的窗体[/color][code=Delphi(Pascal)]
unit UfrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmMain = class(TForm)
btn1: TButton;
btn2: TButton;
btn3: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
private
function CreateFormByClassName(const ClassName: string): TCustomForm;
function CreateDataModuleByClassName(const ClassName: string): TDataModule;
procedure UnloadAddInPackage(ModuleInstance: HMODULE);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
var
ModuleInstance1: HMODULE;
{$R *.dfm}
//---------------------------------------------------------------
//动态加载 Package
//---------------------------------------------------------------
procedure TfrmMain.btn1Click(Sender: TObject);
begin
ModuleInstance1 := LoadPackage('Package1.bpl');
end;
//---------------------------------------------------------------
//将 Package 中的 Form1 带出
//---------------------------------------------------------------
procedure TfrmMain.btn2Click(Sender: TObject);
var
frm : TcustomForm;
begin
frm := CreateFormByClassName('TForm1');
try
frm.ShowModal;
finally
frm.Release;
end;
end;
//---------------------------------------------------------------
//释放 Package
//---------------------------------------------------------------
procedure TfrmMain.btn3Click(Sender: TObject);
begin
UnloadAddInPackage(ModuleInstance1);
end;
//---------------------------------------------------------------
//自订函式 - CreateFormByClassName() , 建立 Form
//---------------------------------------------------------------
function TfrmMain.CreateFormByClassName(const ClassName: string): TCustomForm;
var
AClass: TPersistentClass;
begin
AClass := GetClass(ClassName);
if AClass=nil then exit;
Result := TComponentClass(AClass).Create(Application) as TCustomForm;
//或 Result := TCustomForm(TComponentClass(AClass).Create(Application));
end;
//---------------------------------------------------------------
//自订函式 - CreateDataModuleByClassName() , 建立数据模块
//---------------------------------------------------------------
function TfrmMain.CreateDataModuleByClassName(const ClassName:string): TDataModule;
var
AClass: TPersistentClass;
begin
Result := nil;
AClass := GetClass(ClassName);
if AClass=nil then exit;
Result := TComponentClass(AClass).Create(Application) as TDataModule;
end;
//---------------------------------------------------------------
//自订函式 - UnloadAddInPackage() , 释放 Package
//---------------------------------------------------------------
procedure TfrmMain.UnloadAddInPackage(ModuleInstance: HMODULE);
var
i: Integer;
M: TMemoryBasicInformation;
begin
for i := Application.ComponentCount - 1 downto 0 do
begin
VirtualQuery(GetClass(Application.Components[i].ClassName), M, SizeOf(M));
if (ModuleInstance = 0) or (HMODULE(M.AllocationBase) = ModuleInstance) then
Application.Components[i].Free;
end;
//下面这两个函式应该是只要取其中一个呼叫即可
UnRegisterModuleClasses(ModuleInstance); //直接注销 Package
UnloadPackage(ModuleInstance); //间接注销 , 呼叫 Package 中 的 finalization
end;
end.
[/code] |
|