Delphi中解决MDI的DLL子窗体中的Tab键下移控件问题
关键代码:
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.