VerySource

 找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 825|回复: 3

请教高手我在bpl中的窗体显示不出来?

[复制链接]

1

主题

1

帖子

2.00

积分

新手上路

Rank: 1

积分
2.00
发表于 2020-3-7 23:30:01 | 显示全部楼层 |阅读模式
package中的类已注册:
initialization
  RegisterClass(TForm1);
  showmessage('加载成功');
finalization
  showmessage('卸载成功!');
  UnRegisterClass(TForm1);

调用方法:
function TForm2.CreateFormByClassName(const ClassName: string):Integer;
var
UClass:TPersistentClass;
UForm:TCustomForm;
begin
  Result:=mrNone;
  UClass:=GetClass(className);
  if UClass=nil then
  begin
    ShowMessage('没有找到类');
    Exit;
  end;

  UForm:=TCustomForm(TComponentClass(UClass).Create(Application));
  ShowMessage('包中的类创建成功!');
  UForm.ShowModal;
  
end;
但包中的窗体就是不显示而是显示我定义的"没有找到类",即uclass=nil
我不知道是怎么回事,请高手解答。
回复

使用道具 举报

0

主题

2

帖子

2.00

积分

新手上路

Rank: 1

积分
2.00
发表于 2020-9-1 05:30:01 | 显示全部楼层
建议在TForm1所在的单元中使用

initialization
    RegisterClass(TForm1);
    showmessage( '加载成功 ');
finalization
    showmessage( '卸载成功! ');
    UnRegisterClass(TForm1);
----------------------------------------
有RegisterClass(TForm1)的代码,
必须在本单元,或被引用单元中,

package文件,不能被引用到新工程中!
回复

使用道具 举报

0

主题

1

帖子

2.00

积分

新手上路

Rank: 1

积分
2.00
发表于 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]
回复

使用道具 举报

0

主题

2

帖子

2.00

积分

新手上路

Rank: 1

积分
2.00
发表于 2020-9-1 09:30:01 | 显示全部楼层
楼上的代码很恐怖呀,也很精彩!
不过我还是喜欢直接的解决问题!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|手机版|CopyRight © 2008-2023|verysource.com ( 京ICP备17048824号-1 )

快速回复 返回顶部 返回列表