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...