实现原理是启动一个应用程序,通过ProcessID得到窗体句柄,然后对其设定父窗体句柄为本程序某控件句柄(本例是窗体内一个Panel的句柄),这样就达成了内嵌的效果。
本文实现的是内嵌一个记事本程序,如下图:
在实现细节上需要注意几点:
- 为了美化程序的嵌入效果,需要隐藏其标题栏
- 在外部窗体大小变化时,需要内嵌的窗体也随之变化大小
- 外部程序退出时,内嵌的程序也要退出
下面是例子程序。新建窗体,上面放置一个Panel控件,名为pnlApp,然后按下面代码编写:
Windows,
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
procedure FormCreate(Sender:
TObject); |
procedure FormClose(Sender:
TObject; var Action:
TCloseAction); |
procedure FormResize(Sender:
TObject); |
PProcessWindow
= ^TProcessWindow; |
function EnumWindowsProc(Wnd:
HWND; ProcWndInfo: PProcessWindow): BOOL; stdcall; |
GetWindowThreadProcessId(Wnd,
@WndProcessID); |
if WndProcessID
= ProcWndInfo^.ProcessID then begin |
ProcWndInfo^.FoundWindow
:= Wnd; |
function GetProcessWindow(ProcessID: Cardinal ):
HWND; |
ProcWndInfo:
TProcessWindow; |
ProcWndInfo . ProcessID
:= ProcessID; |
ProcWndInfo . FoundWindow
:= 0 ; |
EnumWindows(@EnumWindowsProc, Integer (@ProcWndInfo)); |
Result
:= ProcWndInfo . FoundWindow; |
function RunAppInPanel( const AppFileName: string ;
ParentHandle: HWND; var WinHandle:
HWND): Boolean ; |
FillChar(si,
SizeOf(si), 0 ); |
si . wShowWindow
:= SW_SHOW; |
if not CreateProcess( nil , PChar (AppFileName), nil , nil , true , |
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil , nil ,
si, pi) then Exit; |
WaitForInputIdle(pi . hProcess, 10000 ); |
WinHandle
:= GetProcessWindow(pi . dwProcessID); |
if WinHandle
> 0 then begin |
Windows . SetParent(WinHandle,
ParentHandle); |
SetWindowPos(WinHandle, 0 , 0 , 0 , 0 , 0 ,
SWP_NOSIZE or SWP_NOZORDER); |
SetWindowLong(WinHandle,
GWL_STYLE, GetWindowLong(WinHandle, GWL_STYLE) |
and ( not WS_CAPTION) and ( not WS_BORDER) and ( not WS_THICKFRAME)); |
CloseHandle(pi . hProcess); |
procedure TForm1 . FormClose(Sender:
TObject; var Action:
TCloseAction); |
if hWin
> 0 then PostMessage(hWin,
WM_CLOSE, 0 , 0 ); |
procedure TForm1 . FormCreate(Sender:
TObject); |
App
= 'C:WindowsNotepad.exe' ; |
pnlApp . Align
:= alClient; |
if not RunAppInPanel(App,
pnlApp . Handle,
hWin) then ShowMessage( 'App
not found' ); |
procedure TForm1 . FormResize(Sender:
TObject); |
if hWin
<> 0 then MoveWindow(hWin, 0 , 0 ,
pnlApp . ClientWidth,
pnlApp . ClientHeight, True ); |
这种方式也存在几个问题:
问题1:如果程序有Splash窗体先显示,则实际窗体无法内嵌,因为仅将Splash窗体的父窗体设定为本程序的控件句柄,后续窗体无法设定。
解决方法:可以通过轮询方式查询后续窗体,并设定其父窗体为本程序的控件句柄。
问题2:点击内嵌程序的窗体,则本程序的标题栏失去焦点
解决方法:不详。
问题3:点击内嵌程序的窗体,按下ALT+F4,则内嵌程序退出,仅留下本程序
解决方法:可以通过Hook方式拦截ALT+F4。