狮山房价:Delphi中解决MDI的DLL子窗体中的Tab键下移控件问题

来源:百度文库 编辑:偶看新闻 时间:2024/05/04 06:32:17

关键代码:
function   TForm1.GetSysFocus:   Integer;  
  var  
      hOtherWin,OtherThreadID,hFocusWin:integer;  
  begin  
      hOtherWin:=GetForegroundWindow;  
      OtherThreadID:=GetWindowThreadProcessID(hOtherWin,nil);  
      if   AttachThreadInput(GetcurrentThreadID,OtherThreadID,True)   then  
      begin  
          hFocusWin:=GetFocus;  
          result:=GetFocus;  
      if   HFocusWin<>0   then  
      try  
      //SendMessage(GetFocus,WM_COPY,0,0);//书上是这么写的  
      finally  
          AttachThreadInput(GetcurrentThreadID,OtherThreadID,False);  
      end;  
      end  
      else   result:=GetFocus;  
  end;   //这段代码是得到当前正在输入控件的Handle
代码://这是主窗体的代码  
  unit   callsdifrm;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   StdCtrls,   ExtCtrls,   ComCtrls,   Menus;  
   
  type  
      TForm1   =   class(TForm)  
          MainMenu1:   TMainMenu;  
          ShowSdi1:   TMenuItem;  
          ShowSdi2:   TMenuItem;  
          CloseSdi1:   TMenuItem;  
          adsfsdf1:   TMenuItem;  
          N121:   TMenuItem;  
          procedure   CloseSdi1Click(Sender:   TObject);  
          procedure   FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
          procedure   FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
          procedure   ShowSdi2Click(Sender:   TObject);  
          procedure   adsfsdf1Click(Sender:   TObject);  
      private  
          {   Private   declarations   }  
          //声明响应WM_HOTKEY消息的方法  
          procedure   WMHotKey(var   Msg:   TWMHotKey);   message   WM_HOTKEY;  
          function   GetSysFocus:   Integer;  
      public  
          {   Public   declarations   }  
          procedure   WMACTIVATEAPP(var   Msg:   TMessage);   message   WM_ACTIVATEAPP;  
      end;  
   
  var  
      Form1:   TForm1;  
      Procedure   ShowFrm(ParentApplication:   TApplication);stdcall;external   'demodll.dll';  
      Procedure   CloseFrm;stdcall;external   'demodll.dll';  
      procedure   freeDll;   stdcall;external   'demodll.dll';  
  implementation  
  const   id_SnapShot   =   115;   //定义热键标识符  
  {$R   *.dfm}  
   
  procedure   TForm1.CloseSdi1Click(Sender:   TObject);  
  begin  
      CloseFrm;  
  end;  
   
  procedure   TForm1.FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
  begin  
      CloseFrm;  
  end;  
   
  procedure   TForm1.FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
  begin  
      freeDll;  
  end;  
   
  procedure   TForm1.ShowSdi2Click(Sender:   TObject);  
  begin  
      ShowFrm(Application);  
  end;  
   
  procedure   TForm1.adsfsdf1Click(Sender:   TObject);  
  begin  
      Close;  
  end;  
   
  procedure   TForm1.WMHotKey(var   Msg:   TWMHotKey);  
  var  
      H:   THandle;  
  begin  
      if   Msg.HotKey   =   id_SnapShot   then  
      begin  
          H   :=   GetSysFocus;  
          while   IsWindow(H)   and   (H   <>   Form1.Handle)   do  
          begin  
              SendMessage(H,WM_NEXTDLGCTL,0,0);  
              H   :=   GetParent(H);  
          end;  
      end;  
  end;  
   
  function   TForm1.GetSysFocus:   Integer;  
  var  
      hOtherWin,OtherThreadID,hFocusWin:integer;  
  begin  
      hOtherWin:=GetForegroundWindow;  
      OtherThreadID:=GetWindowThreadProcessID(hOtherWin,nil);  
      if   AttachThreadInput(GetcurrentThreadID,OtherThreadID,True)   then  
      begin  
          hFocusWin:=GetFocus;  
          result:=GetFocus;  
      if   HFocusWin<>0   then  
      try  
      //SendMessage(GetFocus,WM_COPY,0,0);//书上是这么写的  
      finally  
          AttachThreadInput(GetcurrentThreadID,OtherThreadID,False);  
      end;  
      end  
      else   result:=GetFocus;  
  end;  
   
  procedure   TForm1.WMACTIVATEAPP(var   Msg:   TMessage);  
  begin  
      if   Boolean(Msg.WParam)   then  
          RegisterHotKey(Form1.Handle,   id_SnapShot,   0,   VK_TAB)   //定义热键     在程序得到焦点时  
      else  
          UnRegisterHotKey(Form1.Handle,   id_SnapShot);   //释放已经登记的热键   在程序失去焦点时  
  end;  
   
  end.  
   
  以上是MDI主窗体代码  
   
  下面是子窗体dll中的代码  
  library   demodll;  
   
   
  uses  
      SysUtils,  
      Classes,  
      Forms,  
      Windows,  
      sdifrm   in   'sdifrm.pas'   {frmsdi};  
   
  {$R   *.res}  
   
  exports  
      ShowFrm,CloseFrm,freeDll;  
   
  begin  
      DllApplication   :=   Application;     //一定要将主窗体的Appliction传入,释放时候赋值回去  
  end.

下面这是MDI子窗体的代码  
   
  unit   sdifrm;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   StdCtrls,   ExtCtrls;  
   
      Procedure   ShowFrm(ParentApplication:   TApplication);stdcall;  
      Procedure   CloseFrm;stdcall;  
      procedure   freeDll;   stdcall;  
   
  var  
      DllApplication:   TApplication;  
   
   
  type  
      Tfrmsdi   =   class(TForm)  
          pnlUIfrm:   TPanel;  
          Panel2:   TPanel;  
          Button1:   TButton;  
          Edit1:   TEdit;  
          Edit2:   TEdit;  
          Edit3:   TEdit;  
          Edit4:   TEdit;  
          Edit5:   TEdit;  
          Edit6:   TEdit;  
          procedure   FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      frmsdi:   Tfrmsdi;  
  implementation  
  {$R   *.dfm}  
  procedure   freeDll;stdcall;  
  begin  
      Application   :=   DllApplication;  
  end;  
   
  Procedure   ShowFrm(ParentApplication:   TApplication);stdcall;  
  begin  
      Application   :=   ParentApplication;  
      if   Not   Assigned(frmsdi)   then  
      begin  
          frmsdi   :=   Tfrmsdi.Create(Application);  
          frmsdi.Show;  
      end;  
  end;  
   
  Procedure   CloseFrm;stdcall;  
  begin  
      if   Assigned(frmsdi)   then  
      begin  
          FreeAndNil(frmsdi);  
      end  
      else  
          frmsdi   :=   nil;  
  end;  
   
  procedure   Tfrmsdi.FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
  begin  
      Action   :=   caFree;  
      frmsdi   :=   Nil;  
  end;  
   
  end.