本文主要是介绍Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！
源码下载地址
1.ShareMem的引用要放在各单元的第一位置,否则会报错
2.dll中mdi子窗体关闭时要,
Action:=caFree;
TestForm2:=nil;
3.
主窗体代码
unit MainUnit;interfaceusesShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ComCtrls, Menus, ToolWin, RzTabs,StrUtils;typeTTestdllMdiFrom=Function(App:TApplication;mfrmHdl:THandle;Scr:TScreen;Owner_s:Tform):Tform;stdcall;TGetCaption = function: Pchar; StdCall;TGetFormGuid= function: Pchar; StdCall;EdllLoadError=class(Exception);TTestPlugIn=classcaption: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);privateprocedure MainCopyDataMsg(Var Msg : TMessage); Message WM_COPYDATA; //用于进程 或dll中传递 消息publicprocedure 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;varMainForm: 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); varFound: TSearchRec;Sub: string;i: Integer;Dirs: TStrings;Finished: Integer; beginStopSearch := False;Dirs := TStringList.Create;Finished := FindFirst(Dir + '*.*', 63, Found);while (Finished = 0) and not (StopSearch) dobeginif (Found.Name[1] <> '.') thenbeginif (Found.Attr and faDirectory = faDirectory) thenDirs.Add(Dir + Found.Name) //Add to the directories list.elseif Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 thenFiles.Add(Dir + Found.Name);end;Finished := FindNext(Found);end;FindClose(Found);if not StopSearch thenfor i := 0 to Dirs.Count - 1 doSearchFileExt(Dirs[i], Ext, Files);Dirs.Free; end; //----------------------------------------------------------------- procedure TMainForm.tabControl_SelectedIndexChanged(sender: TObject); var i:Integer; beginif MainForm.MDIChildCount >0 thenbeginfor i:=0 to MainForm.MDIChildCount-1 dobeginif MainTC.TabIndex=i thenbeginMainForm.MDIChildren[i].ActiveMDIChild;end;end; end; end;procedure TMainForm.FormCreate(Sender: TObject); beginif MainTC.Tabs.Count=0 thenMainTC.Height:=0elseMainTC.Height:=28;LoadPlugIns;end;procedure TMainForm.MainTCChange(Sender: TObject); varTabCap:String;I: Integer;Child: TForm; beginif MainTC.Tabs.Count=0 thenbeginMainTC.Height:=0;exit;endelseMainTC.Height:=28;TabCap:=MainTC.Tabs[MainTC.TabIndex].Caption;for I := MDIChildCount - 1 downto 0 dobeginChild := MDIChildren[I];if Child.Caption = TabCap thenChild.Show;end;MainSb.Panels[1].Text:=IntToStr(MainTC.TabIndex);end;procedure TMainForm.TabControcl_ChangeTabPage(sender: TObject); var i:Integer; beginif (Self.MDIChildCount>0) and (MainTC.TabIndex>-1) thenbeginfor i:=0 to Self.MDIChildCount-1 dobeginif MainTC.TabIndex=i thenbeginSelf.MDIChildren[i].WindowState:=wsMaximized;Self.MDIChildren[i].Visible:=True;Self.MDIChildren[i].ActiveMDIChild;endelsebeginif Self.MDIChildren[i].Visible thenSelf.MDIChildren[i].Visible:=False;end; end; end; end;procedure TMainForm.AdjustTabControl(Sender: TForm; Delete: Boolean); varI:Integer;Found:Boolean;tmp_tab:TRzTabCollectionItem; begin//查找Found := False;for I := 0 to MainTC.Tabs.Count - 1 dobeginif Sender.Caption = MainTC.Tabs[i].Caption thenbeginFound := True; //找到if Delete then //删除MainTC.Tabs.Delete(I)else //激活beginif MainTC.TabIndex <> I thenMainTC.TabIndex := I;Sender.WindowState:=wsMaximized; end;break;end;end;if not Found then //增加并激活begintmp_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; begintmpcaption:=MainTC.Tabs.Items[MainTC.TabIndex].Caption ;for i:=0 to MainForm.MDIChildCount-1 dobeginif MainForm.MDIChildren[i].Caption= tmpcaption thenMainForm.MDIChildren[i].Close;end; end;procedure TMainForm.MainCopyDataMsg(var Msg: TMessage); var tmpstr:string;sHead:string;tmpCaption,TMP_frmGuid:string;cdds : TcopyDataStruct; beginif msg.Msg = WM_COPYDATA thenbegincdds := PcopyDataStruct(Msg.LParam)^;tmpstr := (Pchar(cdds.lpData));sHead:=LeftStr(tmpstr,5);if sHead='XFRM:' then //X掉即关闭子窗体begintmpCaption:=RightStr(tmpstr,Length(tmpstr)-5);TabControl_DeleteTabFromCaption(tmpCaption) ;end;if sHead='FUID:' then //根据guid freeFrombeginTMP_frmGuid:=RightStr(tmpstr,Length(tmpstr)-5);// FreePlugIns_fromCapiont(TMP_frmGuid);end;end; end;procedure TMainForm.TabControl_DeleteTabFromCaption(sCaption:string); varI:Integer;Found:Boolean;tmp_tab:TRzTabCollectionItem; begin//查找Found := False;for I := 0 to MainTC.Tabs.Count - 1 dobeginif sCaption = MainTC.Tabs[i].Caption thenbeginFound := True; //找到MainTC.Tabs.Delete(i);break;end;end;end;procedure TMainForm.LoadPlugIns; varFiles: TStrings;i: Integer;TestPlugIn: TTestPlugIn;NewMenu: TMenuItem;GetCaption: TGetCaption;fm:TTestdllMdiFrom;GetFormGuid:TGetFormGuid; beginFiles := TStringList.Create;Plugins := TList.Create;//查找指定目录下的.dll文件，并存于Files对象中SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);//加载查找到的DLLfor i := 0 to Files.Count - 1 dobeginTestPlugIn := TTestPlugIn.Create;TestPlugIn.Address := LoadLibrary(PChar(Files[i]));if TestPlugIn.Address = 0 thenraise 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); //每次在菜单下新增一个模块菜单exceptraise EDLLLoadError.Create('初始化失败');end;end;Files.Free; end;procedure TMainForm.FreePlugIns; vari: Integer;tmpHandl:THandle; begin//将加载的插件全部释放for i := 0 to PlugIns.Count - 1 dobegintmpHandl:=TTestPlugIn(PlugIns[i]).Address;if tmpHandl<>0 thenFreeLibrary(tmpHandl);end;//释放plugIns对象PlugIns.Free; end;procedure TMainForm.PlugInsClick(Sender: TObject); var tmpform:TForm; tmp_swFrom:TTestdllMdiFrom; i:Integer;unit TestUnit;interfaceusesShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTTestForm = class(TForm)Memo1: TMemo;Button1: TButton;procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure Button1Click(Sender: TObject);procedure FormCreate(Sender: TObject);privateprocedure SendKeys(sSend:string);procedure SendParmKeys(sSend:string);//发送运行参数publicend;varTestForm: TTestForm;implementationuses myUnit;{$R *.dfm}procedure TTestForm.FormClose(Sender: TObject; var Action: TCloseAction); beginSendParmKeys('XFRM:'+self.Caption);SendParmKeys('FUID:'+frm_guid);Action:=caFree;TestForm:=nil; end;procedure TTestForm.Button1Click(Sender: TObject); beginSendParmKeys(frm_guid); end; procedure TTestForm.SendKeys(sSend:string); vari:integer;focushld,windowhld:hwnd;threadld:dword;ch: byte; beginwindowhld:=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//该过程发送指定字符串（中英文皆可以）beginch := byte(sSend[ i ]);if Windows.IsDBCSLeadByte(ch) thenbeginInc(i);SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[ i ]), ch), 0);endelseSendMessage(focushld, WM_IME_CHAR, word(ch), 0);Inc(i);end;postmessage(focushld,WM_keydown,13,0);//发送一个虚拟Enter按键 end; procedure TTestForm.SendParmKeys(sSend: string); vartmpstr: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); beginend;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代码
这篇关于Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！
