动态调用包（bpl）的窗体源码

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.