BPL外掛程式框架的二種實現

2021-09-07 22:36:39 字數 4386 閱讀 3406

1)非rtti方式適用於所有的delphi版本

unit untmain;

inte***ce

uses

windows, messages, sysutils,

classes, graphics,

controls, forms, dialogs,

extctrls, buttons;

type

tfrmmain = class(tform)

panel1: tpanel;

speedbutton1: tspeedbutton;

procedure btnclick(sender: tobject);

procedure formdestroy(sender: tobject);

private

procedure loadplugin(const formclass: string);

public

end;

varfrmmain: tfrmmain;

implementation

procedure tfrmmain.btnclick(sender: tobject);

varh: integer;

formclass, bplfile: string;

begin

if sametext(tspeedbutton(sender).caption, '系統一') then

begin

bplfile := 'bpltest1.bpl';

formclass := 'tfrmtest1';

end;

if tspeedbutton(sender).tag = 0 then

begin

if fileexists(bplfile) then

begin

h := loadpackage(bplfile);

if h = 0 then

showmessage(bplfile + ' 包載入失敗')

else

begin

tspeedbutton(sender).tag := h;

end;

endelse

showmessage(bplfile + ' 沒有找到');

end;

loadplugin(formclass);

end;

procedure tfrmmain.formdestroy(sender: tobject);

vari: integer;

begin

for i := 0 to panel1.componentcount - 1 do

begin

if tspeedbutton(panel1.components[i]).tag <> 0 then

unloadpackage(tspeedbutton(panel1.components[i]).tag);

end;

end;

procedure tfrmmain.loadplugin(const formclass: string);

varform: tform;

begin

form := tformclass(findclass(formclass)).create(self);

form.position := poscreencenter;

form.show;

end;

end.

2)rtti方式,適用於2009以上版本

unit untmain;

inte***ce

uses

winapi.windows, winapi.messages, system.sysutils, system.variants,

system.classes, vcl.graphics,

vcl.controls, vcl.forms, vcl.dialogs, system.generics.collections,

system.rtti, vcl.extctrls, vcl.buttons;

type

tfrmmain = class(tform)

panel1: tpanel;

speedbutton1: tspeedbutton;

procedure formdestroy(sender: tobject);

procedure formcreate(sender: tobject);

procedure btnclick(sender: tobject);

private

bpllist: tdictionary;

procedure loadplugin(const bplfile, unitclass: string);

public

end;

varfrmmain: tfrmmain;

implementation

procedure tfrmmain.btnclick(sender: tobject);

varh: integer;

bplfile: string;

unitclass: string;

begin

if sametext(tspeedbutton(sender).caption, '系統一') then

begin

bplfile := 'bpltest1.bpl';

unitclass := 'unttest1.tfrmtest1';

end;

if tspeedbutton(sender).tag = 0 then

begin

if fileexists(bplfile) then

begin

h := loadpackage(bplfile);

if h = 0 then

showmessage(bplfile + ' 包載入失敗')

else

begin

bpllist.add(bplfile, h);

tspeedbutton(sender).tag := h;

end;

end;

end;

loadplugin(bplfile, unitclass);

end;

procedure tfrmmain.formcreate(sender: tobject);

begin

bpllist := tdictionary.create;

end;

procedure tfrmmain.formdestroy(sender: tobject);

vari: integer;

begin

if assigned(bpllist) then

begin

for i in bpllist.values do

unloadpackage(i);

freeandnil(bpllist);

end;

end;

procedure tfrmmain.loadplugin(const bplfile, unitclass: string);

varlcontext: trtticontext;

lpackage: trttipackage;

lclass: trttiinstancetype;

aform: tform;

begin

if (bplfile = '') or (unitclass = '') then

exit;

lcontext := trtticontext.create;

trytry

for lpackage in lcontext.getpackages() do

begin

if sametext(extractfilename(lpackage.name), bplfile) then

begin

lclass := lpackage.findtype(unitclass) as trttiinstancetype;

aform := lclass.metaclasstype.create as tform;

aform.create(nil);

aform.windowstate := wsnormal;

aform.position := poscreencenter;

aform.show;

end;

end;

except

showmessage('單元名和類名是大小寫敏感的');

end;

finally

lcontext.free;

end;

end;

end.

BPL外掛程式框架的二種實現方法

bpl外掛程式框架的二種實現方法 1 非rtti方式適用於所有的delphi版本 unit untmain inte ce uses windows,messages,sysutils,classes,graphics,controls,forms,dialogs,extctrls,buttons ...

二種快排穩定實現

三路快排 void quicksort int a,intleft,intright i 工作指標 j從左向右不斷掃瞄,找大於或者等於錨點元素的元素 while left j a j pivot j 如果兩個工作指標 i j相遇則一趟遍歷結束 if i j break 將左邊大於 pivot 的元素...

iframe區域性重新整理的二種實現方法

一 iframe實現區域性重新整理方法一 1 2 當點a1時在iframe裡顯示a1.html的內容,點a2時在iframe裡顯示a2.html的內容 二 iframe實現區域性重新整理的方法二 1 2 3 ahref a1.html id a1 name a1.html target i 1 ah...