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

源码下载地址

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

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

     Action:=caFree;
    TestForm2:=nil;

3.

主窗体代码

unit MainUnit;interfaceuses  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;interfaceuses  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;implementationuses 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;begintmpstr:=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制作多页面
	  	   
delphi的DLL封装MDI子窗体
	  	   
Delphi dll窗体封装
	  	   
Delphi dll窗体封装
	  	   
Delphi 封装窗体封装DLL
	  	   
用DLL方式封装MDI子窗体。
	  	   
在Dll内封装MDI子窗体
	  	   
用dll方式封装mdi子窗体
	  	   
用dll方式封装mdi子窗体
	  	   
Delphi – 在DLL中保存并创建MDI子窗体（翻译）
	  	   
VC++中把窗体封装到dll中并调用
	  	   
VC++中把窗体封装到dll中并调用
	  	   
TabControl多页面窗体用法（vb2010）
	  	   
Delphi封装类到DLL
	  	   
在dll中delphi中封装窗体
	  	   
Java制作MDI窗体
	  	   
制作 MDI窗体
	  	   
mdi子窗口封装到dll（测试通过）
	     		  
	  	   
Web入门必看HTML编写的30条建议
	  	   
多层前馈神经元网络
	  	   
android如何在activity启动的时候隐藏输入法软键盘
	  	   
什么是BIOS
	  	   
Win7下java用JDBC方式连接mysql
	  	   
Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面
	  	   
js缓存
	  	   
截取携程流量 ?
	  	   
数据库系统基础教程三：高级数据库模型的表示
	  	   
DWZ刷新dialog
	  	   
google code提交时登陆密码
	  	   
【小蒙淘金】1.27周评-金银下周行情预测及部分操作建议
	  	   
Ubuntu10.04中minicom、Centos5中NFS环境搭建详解
	  	   
Prim 算法实现最小生成树 打印出对应的最小生成树和最小生成树的总权值