实现原理是启动一个应用程序，通过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。
Technorati 标签:
Delphi,
CreateProcess,
WaitForInputIdle,
EnumWindows,
SetParent,
SetWindowLong,
GetWindowLong,
MoveWindow,
STARTUPINFO,
TProcessInformation
爱生活，爱拉风
实现原理是启动一个应用程序，通过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。
Technorati 标签:
Delphi,
CreateProcess,
WaitForInputIdle,
EnumWindows,
SetParent,
SetWindowLong,
GetWindowLong,
MoveWindow,
STARTUPINFO,
TProcessInformation