Delphi带包编译实现插件方式开发

最新推荐文章于 2019-09-04 14:58:00 发布

五哥

最新推荐文章于 2019-09-04 14:58:00 发布

阅读量3.8k

点赞数

分类专栏： Delphi 7.0

Delphi 7.0 专栏收录该内容

13 篇文章

订阅专栏

Delphi带包编译实现插件方式开发

转载自：http://blog.youkuaiyun.com/henreash/article/details/7029844

1. 新建一个exe执行文件作为主框架,并建立一个存放插件类的单元,建立插件类TTestClass.接着新添加一个单元TestClasses1,在其中添加一个继承于TTestClass的类TTestClass1,并在单元的initialization节中调用基类TTestClasses1的RegistClass方法注册类型.

其中RegistClass方法为类方法；

class procedure RegistClass;

class function GetRegistClasses: TStrings;

步骤：

1.1、创建一个Application ，如下图

保存单元UMain.pas ，项目文件为 Main.dpr, 即编译出来的exe为 Main.exe

窗体如下图：

UMain.pas代码为：

unit UMain;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

  TForm1 = class(TForm)

    btn1: TButton;

    btn2: TButton;

    cbClassName: TComboBox;

    procedure btn1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure FormCreate(Sender: TObject);

    procedure btn2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  HModel: Cardinal;

  HDll: Cardinal;

 

implementation

uses

  TestClasses;

 

{$R *.dfm}

 

//按钮1的单击事件

procedure TForm1.btn1Click(Sender: TObject);

var

  oList: TStrings;

  i: Integer;

  oClass: TTestClassClass;

  oObj: TTestClass;

begin

  oList := TTestClass.GetRegistClasses;

  for i := 0 to oList.Count - 1 do

  begin

    oClass := TTestClassClass(oList.Objects[i]);

    oObj := oClass.Create;

    ShowMessage(oClass.ClassName);

    oObj.ShowSomeMessage;

    oObj.Free;

  end;

 

end;

 

//窗口的关闭事件

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  UnloadPackage(HModel);//卸载运行时包

end;

 

//窗口的创建事件

procedure TForm1.FormCreate(Sender: TObject);

var

  oList: TStrings;

  I: Integer;

begin

  HModel := LoadPackage('Package1.bpl');

  HDll := LoadLibrary('PjtDll.dll');

 

  oList := TTestClass.GetRegistClasses;

 

  cbClassName.Items.BeginUpdate;

  cbClassName.Items.Clear;

  for I := 0 to oList.Count - 1 do

  begin

    cbClassName.Items.Add(oList.ValueFromIndex[I]);

  end;

  if (oList.Count > 0) then

    cbClassName.ItemIndex := 0;

 

  cbClassName.Items.EndUpdate;

 

end;

//按钮2的单击事件

procedure TForm1.btn2Click(Sender: TObject);

var

  oList: TStrings;

  i: Integer;

  oClass: TTestClassClass;

  oObj: TTestClass;

  pClass: TClass;

  strClass: string;

begin

  oList := TTestClass.GetRegistClasses;

  oClass := TTestClassClass(oList.Objects[oList.IndexOf(cbClassName.Text)]);

  oObj := oClass.Create;

  pClass := oObj.ClassType;

  while (pClass <> nil) do

  begin

    strClass := strClass + #10#13 + '-- ' + pClass.ClassName;

    pClass := pClass.ClassParent;

 

  end;

  ShowMessage(strClass) ;//oClass.ClassName);

  oObj.ShowSomeMessage;

  oObj.Free;

 

end;

 

end.

1.2、创建TestClasses.pas

File-->New-->Unit, 命名为TestClasses.pas,代码如下：

unit TestClasses;

 

interface

uses Windows, Classes, SysUtils;

 

type

  TTestClassClass = class of TTestClass;

  TTestClass = class(TObject) //

    class procedure RegistClass;//类过程

    class function GetRegistClasses: TStrings;//类函数

 

    procedure ShowSomeMessage; virtual; //定义虚方法，子类实现

  end;

  

implementation

var

  FClassList: TStringList;

 

  { TTestClass }

 

class function TTestClass.GetRegistClasses: TStrings;

begin

  Result := FClassList;

end;

 

class procedure TTestClass.RegistClass;

begin

  FClassList.AddObject(Self.ClassName, TObject(Self));

end;

 

procedure TTestClass.ShowSomeMessage;

begin

  raise Exception.Create('not implementation');

end;

 

initialization

  if (not Assigned(FClassList)) then

    FClassList := TStringList.Create;

 

finalization

  if (Assigned(FClassList)) then

    FreeAndNil(FClassList);

end.

1.3、类似1.2，添加TestClasses1.pas,代码如下：

unit TestClasses1;

interface

uses Windows, Classes, TestClasses, Dialogs;

type

TTestClasses1 = class(TTestClass)

procedure ShowSomeMessage; override;

end;

implementation

{ TTestClasses1 }

procedure TTestClasses1.ShowSomeMessage;

begin