[代碼]Delphi實(shí)現窗體內嵌其他應用程序窗體

實(shí)現原理是啟動(dòng)一個(gè)應用程序，通過(guò)ProcessID得到窗體句柄，然后對其設定父窗體句柄為本程序某控件句柄(本例是窗體內一個(gè)Panel的句柄)，這樣就達成了內嵌的效果。

本文實(shí)現的是內嵌一個(gè)記事本程序，如下圖：

在實(shí)現細節上需要注意幾點(diǎn)：

1. 為了美化程序的嵌入效果，需要隱藏其標題欄
2. 在外部窗體大小變化時(shí)，需要內嵌的窗體也隨之變化大小
3. 外部程序退出時(shí)，內嵌的程序也要退出

下面是例子程序。新建窗體，上面放置一個(gè)Panel控件，名為pnlApp，然后按下面代碼編寫(xiě)：

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;

 

  // 啟動(dòng)進(jìn)程

  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;

 

  // 等待進(jìn)程啟動(dòng)

  WaitForInputIdle(pi.hProcess, 10000);

 

  // 取得進(jìn)程的 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

  // 退出時(shí)向內嵌程序發(fā)關(guān)閉消息

  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;

 

  // 啟動(dòng)內嵌程序

  if not RunAppInPanel(App, pnlApp.Handle, hWin) then ShowMessage('App not found');

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

  // 保持內嵌程序充滿(mǎn) pnlApp

  if hWin <> 0 then MoveWindow(hWin, 0, 0, pnlApp.ClientWidth, pnlApp.ClientHeight, True);

end;

 

end.

這種方式也存在幾個(gè)問(wèn)題：

問(wèn)題1：如果程序有Splash窗體先顯示，則實(shí)際窗體無(wú)法內嵌，因為僅將Splash窗體的父窗體設定為本程序的控件句柄，后續窗體無(wú)法設定。

解決方法：可以通過(guò)輪詢(xún)方式查詢(xún)后續窗體，并設定其父窗體為本程序的控件句柄。

問(wèn)題2：點(diǎn)擊內嵌程序的窗體，則本程序的標題欄失去焦點(diǎn)

解決方法：不詳。

問(wèn)題3：點(diǎn)擊內嵌程序的窗體，按下ALT+F4，則內嵌程序退出，僅留下本程序

解決方法：可以通過(guò)Hook方式攔截ALT+F4。

Technorati 標簽: Delphi,CreateProcess,WaitForInputIdle,EnumWindows,SetParent,SetWindowLong,GetWindowLong,MoveWindow,STARTUPINFO,TProcessInformation