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