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

最新推荐文章于 2022-08-18 15:28:19 发布
PhoenixTR
最新推荐文章于 2022-08-18 15:28:19 发布
阅读量4.1k
点赞数
本文链接：https://blog.csdn.net/spd260/article/details/8546504
版权
源码下载地址
1.ShareMem的引用要放在各单元的第一位置,否则会报错
2.dll中mdi子窗体关闭时要,
Action:=caFree;
TestForm2:=nil;
主窗体代码
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代码
PhoenixTR
关注
0
点赞
踩
6

收藏

觉得还不错? 一键收藏
1
评论
Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面

源码下载地址1.ShareMem的引用要放在各单元的第一位置,否则会报错2.dll中mdi子窗体关闭时要, Action:=caFree; TestForm2:=nil;3.主窗体代码unit MainUnit;interfaceuses ShareMem,Windows, Messages, Sys
复制链接

扫一扫