Delphi SetParent 嵌入其他应用程序

[代码]Delphi实现窗体内嵌其他应用程序窗体

实现原理是启动一个应用程序，通过ProcessID得到窗体句柄，然后对其设定父窗体句柄为本程序某控件句柄(本例是窗体内一个Panel的句柄)，这样就达成了内嵌的效果。

本文实现的是内嵌一个记事本程序，如下图：

在实现细节上需要注意几点：

1. 为了美化程序的嵌入效果，需要隐藏其标题栏
2. 在外部窗体大小变化时，需要内嵌的窗体也随之变化大小
3. 外部程序退出时，内嵌的程序也要退出

下面是例子程序。新建窗体，上面放置一个Panel控件，名为pnlApp，然后按下面代码编写：

unit frmTestEmbedApp;

interface

uses

  Windows,
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs,
ExtCtrls;

type

  TForm1
= class(TForm)

    pnlApp:
TPanel;

    procedure FormCreate(Sender:
TObject);

    procedure FormClose(Sender:
TObject; var Action:
TCloseAction);

    procedure FormResize(Sender:
TObject);

  private

    {
Private declarations }

  public

    {
Public declarations }

  end;

var

  Form1:
TForm1;

  hWin:
HWND = 0;

implementation

{$R
*.dfm}

type

  //
存储窗体信息

  PProcessWindow
= ^TProcessWindow;

  TProcessWindow
= record

    ProcessID: Cardinal;

    FoundWindow:
hWnd;

  end;

//
窗体枚举函数

function EnumWindowsProc(Wnd:
HWND; ProcWndInfo: PProcessWindow): BOOL; stdcall;

var

  WndProcessID: Cardinal;

begin

  GetWindowThreadProcessId(Wnd,
@WndProcessID);

  if WndProcessID
= ProcWndInfo^.ProcessID then begin

    ProcWndInfo^.FoundWindow
:= Wnd;

    Result
:= False;                                    //
已找到，故停止 EnumWindows

  end

  else

    Result
:= True;                                     //
继续查找

end;

//
由 ProcessID 查找窗体 Handle

function GetProcessWindow(ProcessID: Cardinal):
HWND;

var

  ProcWndInfo:
TProcessWindow;

begin

  ProcWndInfo.ProcessID
:= ProcessID;

  ProcWndInfo.FoundWindow
:= 0;

  EnumWindows(@EnumWindowsProc, Integer(@ProcWndInfo)); //
查找窗体

  Result
:= ProcWndInfo.FoundWindow;

end;

//
在 Panel 上内嵌运行程序

function RunAppInPanel(const AppFileName: string;
ParentHandle: HWND; var WinHandle:
HWND): Boolean;

var

  si:
STARTUPINFO;

  pi:
TProcessInformation;

begin

  Result
:= False;

  //
启动进程

  FillChar(si,
SizeOf(si), 0);

  si.cb
:= SizeOf(si);

  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);

  //
取得进程的 Handle

  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));

    Result
:= True;

  end;

  //
释放 Handle

  CloseHandle(pi.hProcess);

  CloseHandle(pi.hThread);

end;

procedure TForm1.FormClose(Sender:
TObject; var Action:
TCloseAction);

begin

  //
退出时向内嵌程序发关闭消息

  if hWin
> 0 then PostMessage(hWin,
WM_CLOSE, 0, 0);

end;

procedure TForm1.FormCreate(Sender:
TObject);

const

  App
= 'C:\Windows\Notepad.exe';

begin

  pnlApp.Align
:= alClient;

  //
启动内嵌程序

  if not RunAppInPanel(App,
pnlApp.Handle,
hWin) then ShowMessage('App
not found');

end;

procedure TForm1.FormResize(Sender:
TObject);

begin

  //
保持内嵌程序充满 pnlApp

  if hWin
<> 0 then MoveWindow(hWin, 0, 0,
pnlApp.ClientWidth,
pnlApp.ClientHeight, True);

end;

end.

这种方式也存在几个问题：

问题1：如果程序有Splash窗体先显示，则实际窗体无法内嵌，因为仅将Splash窗体的父窗体设定为本程序的控件句柄，后续窗体无法设定。

解决方法：可以通过轮询方式查询后续窗体，并设定其父窗体为本程序的控件句柄。

问题2：点击内嵌程序的窗体，则本程序的标题栏失去焦点

解决方法：不详。

问题3：点击内嵌程序的窗体，按下ALT+F4，则内嵌程序退出，仅留下本程序

解决方法：可以通过Hook方式拦截ALT+F4。