关闭

bpl 使用之我见

887人阅读 评论(0) 收藏 举报

写在前面
  在此不再赘述bpl与dll的比较,只介绍bpl的动态调用。如需转载敬请保留原版作者信息,
  及实现部分的完整性,
开始---------------------------------------->
        实现过程
           <第一部分 接口单元>
                创建一个接口单元
                {$WEAKPACKAGEUNIT}
                unit uInterface;

                interface
                uses
                  Classes, Forms;
                type
                  TBaseClss = class(TComponent)
                    function CreateForm:TForm; virtual; stdcall;abstract;
                    ...
                  end;

                implementation

                { TBaseClss }


                end.


            <第二部分 调用的主程序>
                选项设置
                Project -> Options -> Packages : Runtime Packages
                        将Build with Runtime Packages复选框选中;

                引用uInterface单元

                调用过程
                function LoadPacket(Fbpl, FClass: String): Boolean;
                var
                  FForm  : TForm;
                  FPersistentClass: TPersistentClass;
                  FBaseClss : TBaseClss;
                  H: HMODULE;
                begin
                  try
                    try
                      H := 0;
                      H := LoadPackage(Fbpl);
                      FPersistentClass := FindClass(FClass);
                      if FPersistentClass <> nil then
                      begin
                        FBaseClss :=
                        TBaseClss(TComponentClass(FPersistentClass).Create(Application));
                        FForm := nil;
                        FForm := FBaseClss.CreateForm;
                        FBaseClss.Free;
                        FBaseClss := nil;
                        FPersistentClass := nil;
                        if Assigned(FForm) then
                        begin
                          FForm.ShowModal;
                          FreeAndNil(FForm);
                        end;
                      end;
                    except
                      Application.MessageBox('此功能未安装', '提示', MB_OK +
                        MB_ICONINFORMATION);
                    end;
                  finally
                    if H <> 0 then
                    begin
                      UnloadPackage(H);
                      H := 0;
                    end;
                  end;
                end;

            <第三部分 创建bpl包>
                创建包

                引用uInterface单元

                创建接口类,实现TBaseClss
                  TTestClass = class(TBaseClss)
                    function CreateForm:TForm; override;
                    ...
                  end;

                function TTestClass.CreateForm: TForm;
                var
                  Form2: TForm2;
                begin
                  Form2 := TForm2.Create(Application);
                  if Assigned(Form2) then
                    Result := Form2
                  else
                    Result := nil;
                end;


                注册类
                initialization
                  RegisterClass(TTestClass);
                  UnRegisterClass(TBaseClss);
                反注册类
                finalization
                  UnRegisterClass(TTestClass);
--------------------------结束>

 
0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:53957次
    • 积分:683
    • 等级:
    • 排名:千里之外
    • 原创:32篇
    • 转载:36篇
    • 译文:0篇
    • 评论:2条
    文章分类
    最新评论