一 编写DLL
新建一dpr文件
library PDLL;
uses
Sysutils,classes,main in 'main.pas';
{$E plg.} //定义后缀名为plg
exports
DescribePlugin,
InitPlugin;
begin
end;
main.pas为:
unit main
interface
uses Dialogs,Menus,Classes;
type
THolder=class
public
procedure ClickHandler(Sender:TObject);
end
procedure DescribePlugin(var Desc:pchar);export;stdcall;
procedure InitPlugin(ParentMenu:TMainMenu);export;stdcall;
var
Holder:THolder;
implementation
procedure DescribePlugin(var Desc:pchar);
begin
Desc :=pchar('Test plugin 2-Menu test');
end;
procedure InitPlugin(ParentMenu:TMainMenu);
var
i:TMainItem;
begin
i :=NewItem('Plugin & Test',scNone,False,True,Holder.ClickHandler,0,'mnuTest');
ParentMenu.Items[1].Add(i);
end;
procedure THolder:ClickHandler;
begin
ShowMessge('Clicked');
end;
initialization
Holder :=THolder.Create;
finalization
Holder.Fee;
end;
将此文件编译成DLL文件(pdll.plg)
二 编写测试程序
1.绘制窗体
略......2.编写代码
(1) 定义常量
const
cPLUGIN_INIT='InitPlugin';
cPlugin_DESCRIBE='DescribePlugin';
(2) 定义过程类型
type
TPluginDescribe=procedure (var Desc:pchar);stdcall;
TPluginInit=procedure (ParentMenu:TMainMenu);stdcall;
(3) 定义两私有过程
procedure LoadPlugin(sr:TSearchRec);
(4) 过程实现代码
procedure TfrmMain.LoadPlugin(srLTSearchRec);
var
Description:pchar;
LibHandle:Integer;
DescribeProc:TPluginDescribe;
InitProc:TPluginInit;
begin
LibHandle:=LoadLibrary(pchar('PlugDLL\'+sr.Name));
if LibHandle<>0 then
begin
DescribeProc :=GetProcAddress(LibHandle,cPlugin_DESCRIBE);
if Assigned(DescribeProc) then
begin
DescribeProc(Description);
Plugins.Lines.Add(strPas(Description));
InitProc :=GetProcAddress(LibHandle,cPLUGIN_INIT);
if Assigned(InitProc) then
begin
InitProc(menuMain);
end;
end
else
begin
MessageDlg('Fle "'+sr.Name+'" is not a valid plugin.',mtInformation,[mbOk],0);
end;
end
else
MessageDlg('An Error occured loading the plugin "'+sr.Name+'"',mtInformation,[mbOk],0)
end;
end;
procedure TfrmMain.LoadPlugins;
var
sr:TSearchRec;
path:string;
Found:Integer;
begin
path :=ExtractFilePath(Application.ExeName);
try
Found :=FindFirst(path+'plugDLL\*.plg',faAnyFile,sr);
while Found=0 do
begin
LoadPlugins(sr);
Found :=FindNext(sr);
end;
finally
FindClose(sr);
end;
end;
Button1的OnClick事件
var
i:TMenuItem;
begin
i:=NewItem('PLugin &Test',srNone,False,True,nil,0,'mnuTest');
menumain.Items[i].add(i);
end;
Button2的OnClick事件：
LoadPlugins;