Delphi实现窗体内嵌其他应用程序窗体

原作者: [db:作者] 来自: [db:来源] 收藏邀请

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

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

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

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

下面是例子程序。新建窗体，上面放置一个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。

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

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

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

下面是例子程序。新建窗体，上面放置一个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.