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。

Technorati 标签:  Delphi, CreateProcess, WaitForInputIdle, EnumWindows, SetParent, SetWindowLong, GetWindowLong, MoveWindow, STARTUPINFO, TProcessInformation