Delphi SetParent 嵌入其他应用程序

2022-09-27 10:51:31

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

实现原理是启动一个应用程序，通过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。

码农公寓

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

相关文章