Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面

源码下载地址

1.ShareMem的引用要放在各单元的第一位置,否则会报错

2.dll中mdi子窗体关闭时要,

Action:=caFree;

TestForm2:=nil;

3.



主窗体代码

unit MainUnit;

interface

uses
ShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Menus, ToolWin, RzTabs,StrUtils;

type
TTestdllMdiFrom=Function(App:TApplication;mfrmHdl:THandle;Scr:TScreen;Owner_s:Tform):Tform;stdcall;
TGetCaption = function: Pchar; StdCall;
TGetFormGuid= function: Pchar; StdCall;
EdllLoadError=class(Exception);
TTestPlugIn=class
caption:string;//加载的getption返加地址
Address:THandle;//存取加载的dll的地址
call:Pointer;//存取ShowDllForm的句柄
guid:string;//窗体的唯一标识
end;

TMainForm = class(TForm)
MainSb: TStatusBar;
MainMenu1: TMainMenu;
N1: TMenuItem;
N_Window: TMenuItem;
testForm1: TMenuItem;
N2: TMenuItem;
N21: TMenuItem;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
MainTC: TRzTabControl;
N_plugins: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MainTCChange(Sender: TObject);

procedure MainTCClose(Sender: TObject; var AllowClose: Boolean);
procedure FormDestroy(Sender: TObject);
private
procedure MainCopyDataMsg(Var Msg : TMessage); Message WM_COPYDATA; //用于进程 或dll中传递 消息
public
procedure tabControl_SelectedIndexChanged(sender:TObject);
procedure TabControcl_ChangeTabPage(sender:TObject);
procedure AdjustTabControl(Sender:TForm;   Delete:Boolean);

procedure TabControl_DeleteTabFromCaption(sCaption:string);//窗体关闭时能过标题关闭窗体
//---
procedure LoadPlugIns;//加载插件到菜单
procedure PlugInsClick(Sender: TObject); //插件菜单点击事件
procedure FreePlugIns; //释放插件

end;

var
MainForm: TMainForm;
ShowDllFrom:TTestdllMdiFrom;  //声明接口函数数型
Plugins:TList;//存放每个Dll加载后的相关信息
StopSearch:Boolean;
//  function ShowDllForm( App:TApplication;Scr:TScreen;Owner_s:Tform): Boolean;stdcall; external 'TestDllFrm.dll';//为了简单，使用静态调用方法
implementation

{$R *.dfm}
//
//查找文件，并存于Files中
procedure SearchFileExt(const Dir, Ext: string; Files: TStrings);
var
Found: TSearchRec;
Sub: string;
i: Integer;
Dirs: TStrings;
Finished: Integer;
begin
StopSearch := False;
Dirs := TStringList.Create;
Finished := FindFirst(Dir + '*.*', 63, Found);
while (Finished = 0) and not (StopSearch) do
begin
if (Found.Name[1] <> '.') then
begin
if (Found.Attr and faDirectory = faDirectory) then
Dirs.Add(Dir + Found.Name) //Add to the directories list.
else
if Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 then
Files.Add(Dir + Found.Name);
end;
Finished := FindNext(Found);
end;
FindClose(Found);
if not StopSearch then
for i := 0 to Dirs.Count - 1 do
SearchFileExt(Dirs[i], Ext, Files);
Dirs.Free;
end;
//-----------------------------------------------------------------
procedure TMainForm.tabControl_SelectedIndexChanged(sender: TObject);
var i:Integer;
begin
if   MainForm.MDIChildCount   >0 then
begin
for i:=0 to MainForm.MDIChildCount-1 do
begin
if  MainTC.TabIndex=i then
begin
MainForm.MDIChildren[i].ActiveMDIChild;
end;
end;
end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
if MainTC.Tabs.Count=0 then
MainTC.Height:=0
else
MainTC.Height:=28;
LoadPlugIns;

end;

procedure TMainForm.MainTCChange(Sender: TObject);
var
TabCap:String;
I:   Integer;
Child:   TForm;
begin
if MainTC.Tabs.Count=0 then
begin
MainTC.Height:=0;
exit;
end
else
MainTC.Height:=28;

TabCap:=MainTC.Tabs[MainTC.TabIndex].Caption;
for   I   :=   MDIChildCount   -   1   downto   0   do
begin
Child   :=   MDIChildren[I];
if   Child.Caption   =     TabCap   then
Child.Show;
end;

MainSb.Panels[1].Text:=IntToStr(MainTC.TabIndex);
end;

procedure TMainForm.TabControcl_ChangeTabPage(sender: TObject);
var i:Integer;
begin
if (Self.MDIChildCount>0) and (MainTC.TabIndex>-1) then
begin
for i:=0 to Self.MDIChildCount-1 do
begin
if MainTC.TabIndex=i then
begin
Self.MDIChildren[i].WindowState:=wsMaximized;
Self.MDIChildren[i].Visible:=True;
Self.MDIChildren[i].ActiveMDIChild;
end
else
begin
if Self.MDIChildren[i].Visible then
Self.MDIChildren[i].Visible:=False;
end;
end;
end;
end;

procedure TMainForm.AdjustTabControl(Sender: TForm; Delete: Boolean);
var
I:Integer;
Found:Boolean;
tmp_tab:TRzTabCollectionItem;
begin
//查找
Found   :=   False;
for   I   :=   0   to   MainTC.Tabs.Count   -   1   do
begin
if   Sender.Caption   =   MainTC.Tabs[i].Caption   then
begin
Found   :=   True;   //找到
if   Delete   then   //删除
MainTC.Tabs.Delete(I)
else     //激活
begin
if   MainTC.TabIndex   <>   I   then
MainTC.TabIndex   :=   I;
Sender.WindowState:=wsMaximized;
end;

break;
end;
end;

if   not   Found   then   //增加并激活
begin
tmp_tab:=TRzTabCollectionItem.Create(MainTC.Tabs);
tmp_tab.Caption:=Sender.Caption;
tmp_tab.Hint:=IntToStr(Sender.Handle);
MainTC.TabIndex   :=   MainTC.Tabs.Count   -   1;
end;
MainSb.Panels[3].Text :='handle:'+inttostr(MainForm.Handle);
end;

procedure TMainForm.MainTCClose(Sender: TObject; var AllowClose: Boolean);
var i:Integer;
tmpcaption:string;
begin

tmpcaption:=MainTC.Tabs.Items[MainTC.TabIndex].Caption   ;
for i:=0 to MainForm.MDIChildCount-1 do
begin

if MainForm.MDIChildren[i].Caption=  tmpcaption       then
MainForm.MDIChildren[i].Close;

end;
end;

procedure TMainForm.MainCopyDataMsg(var Msg: TMessage);
var tmpstr:string;
sHead:string;
tmpCaption,TMP_frmGuid:string;
cdds : TcopyDataStruct;
begin
if msg.Msg = WM_COPYDATA then
begin
cdds := PcopyDataStruct(Msg.LParam)^;
tmpstr := (Pchar(cdds.lpData));
sHead:=LeftStr(tmpstr,5);
if sHead='XFRM:'  then  //X掉即关闭子窗体
begin
tmpCaption:=RightStr(tmpstr,Length(tmpstr)-5);
TabControl_DeleteTabFromCaption(tmpCaption)  ;
end;
if sHead='FUID:'  then  //根据guid freeFrom
begin
TMP_frmGuid:=RightStr(tmpstr,Length(tmpstr)-5);
// FreePlugIns_fromCapiont(TMP_frmGuid);
end;
end;
end;

procedure TMainForm.TabControl_DeleteTabFromCaption(sCaption:string);
var
I:Integer;
Found:Boolean;
tmp_tab:TRzTabCollectionItem;
begin
//查找
Found   :=   False;
for   I   :=   0   to   MainTC.Tabs.Count   -   1   do
begin
if   sCaption   =   MainTC.Tabs[i].Caption   then
begin
Found   :=   True;   //找到

MainTC.Tabs.Delete(i);

break;
end;
end;

end;

procedure TMainForm.LoadPlugIns;
var
Files: TStrings;
i: Integer;
TestPlugIn: TTestPlugIn;
NewMenu: TMenuItem;
GetCaption: TGetCaption;
fm:TTestdllMdiFrom;
GetFormGuid:TGetFormGuid;
begin
Files := TStringList.Create;
Plugins := TList.Create;
//查找指定目录下的.dll文件，并存于Files对象中
SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);
//加载查找到的DLL
for i := 0 to Files.Count - 1 do
begin
TestPlugIn := TTestPlugIn.Create;
TestPlugIn.Address := LoadLibrary(PChar(Files[i]));
if TestPlugIn.Address = 0 then
raise EDLLLoadError.Create('装载' + PChar(Files[i]) + '失败');
try
@GetCaption := GetProcAddress(TestPlugIn.Address, 'GetCaption');
TestPlugIn.Caption := GetCaption;

@fm:=GetProcAddress(TestPlugIn.Address, 'ShowDllForm');
TestPlugIn.call:=@fm   ;

@GetFormGuid:=GetProcAddress(TestPlugIn.Address,'GetFormGuid') ;
TestPlugIn.guid:=GetFormGuid;

PlugIns.Add(TestPlugIn);
//创建菜单，并将菜单标题，Onclick事件赋值
NewMenu := TMenuItem.Create(Self);
NewMenu.Caption := TestPlugIn.Caption;
NewMenu.OnClick := PlugInsClick;
NewMenu.Tag := i;
N_plugins.Add(NewMenu); //每次在菜单下新增一个模块菜单
except
raise EDLLLoadError.Create('初始化失败');
end;
end;
Files.Free;
end;

procedure TMainForm.FreePlugIns;
var
i: Integer;
tmpHandl:THandle;
begin
//将加载的插件全部释放

for i := 0 to PlugIns.Count - 1 do
begin
tmpHandl:=TTestPlugIn(PlugIns[i]).Address;
if tmpHandl<>0 then
FreeLibrary(tmpHandl);
end;
//释放plugIns对象
PlugIns.Free;
end;

procedure TMainForm.PlugInsClick(Sender: TObject);
var tmpform:TForm;
tmp_swFrom:TTestdllMdiFrom;
i:Integer;unit TestUnit;

interface

uses
ShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TTestForm = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure SendKeys(sSend:string);
procedure SendParmKeys(sSend:string);//发送运行参数

public

end;

var
TestForm: TTestForm;

implementation

uses myUnit;

{$R *.dfm}

procedure TTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SendParmKeys('XFRM:'+self.Caption);
SendParmKeys('FUID:'+frm_guid);
Action:=caFree;
TestForm:=nil;
end;

procedure TTestForm.Button1Click(Sender: TObject);
begin
SendParmKeys(frm_guid);
end;
procedure TTestForm.SendKeys(sSend:string);
var
i:integer;
focushld,windowhld:hwnd;
threadld:dword;
ch: byte;
begin
windowhld:=GetForegroundWindow;//获得前台应用程序的活动窗口的句柄
threadld:=GetWindowThreadProcessId(Windowhld,nil);//获取与指定窗口关联在一起的一个进程和线程标识符
AttachThreadInput(GetCurrentThreadId,threadld,true);
//通常，系统内的每个线程都有自己的输入队列。            //
//AttachThreadInput允许线程和进程共享输入队列。         //
//连接了线程后，输入焦点、窗口激活、鼠标捕获、键盘状态 //
//以及输入队列状态都会进入共享状态                      //
Focushld:=getfocus;
//获得拥有输入焦点的窗口的句柄
AttachThreadInput(GetCurrentThreadId,threadld,false);
if focushld = 0 then Exit;
//如果没有输入焦点则退出发送过程
i := 1;
while i <= Length(sSend) do
//该过程发送指定字符串（中英文皆可以）
begin
ch := byte(sSend[ i ]);
if Windows.IsDBCSLeadByte(ch) then
begin
Inc(i);
SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[ i ]), ch), 0);
end
else
SendMessage(focushld, WM_IME_CHAR, word(ch), 0);
Inc(i);
end;
postmessage(focushld,WM_keydown,13,0);
//发送一个虚拟Enter按键
end;
procedure TTestForm.SendParmKeys(sSend: string);
var
tmpstr:string;
cdds : TCopyDataStruct;
begin
tmpstr:=sSend;
cdds.dwData := 0;
cdds.cbData := length(tmpstr)+1;
cdds.lpData := pchar(tmpstr);
SendMessage(DllMfrmHdl,WM_COPYDATA,0,LongWord(@cdds));

end;

procedure TTestForm.FormCreate(Sender: TObject);
begin

end;

end.

fmPointer:Pointer;begin i:= TMenuItem(Sender).Tag; tmp_swFrom:=TTestPlugIn(PlugIns[i]).call;//TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Child_Form:= TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Call; //执行showDllForm函数 tmpform:=tmp_swFrom(application,Self.Handle,Screen,Self);
if Assigned(tmpform) then begin with tmpform do begin WindowState:=wsMaximized; Show;//--改为fORM.ShowModal end; AdjustTabControl( tmpform,False); end;end;procedure TMainForm.FormDestroy(Sender: TObject);begin FreePlugins;end;end.

dll窗体1代码