[代码]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(nilPChar(AppFileName), nilniltrue,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nilnil, si, pi) then Exit;
 
  // 等待进程启动
  WaitForInputIdle(pi.hProcess, 10000);
 
  // 取得进程的 Handle
  WinHandle := GetProcessWindow(pi.dwProcessID);
  if WinHandle > 0 then begin
    // 设定父窗体
    Windows.SetParent(WinHandle, ParentHandle);
 
    // 设定窗体位置
    SetWindowPos(WinHandle, 00000, 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, 00);
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, 00, pnlApp.ClientWidth, pnlApp.ClientHeight, True);
end;
 
end.

这种方式也存在几个问题:

问题1:如果程序有Splash窗体先显示,则实际窗体无法内嵌,因为仅将Splash窗体的父窗体设定为本程序的控件句柄,后续窗体无法设定。

解决方法:可以通过轮询方式查询后续窗体,并设定其父窗体为本程序的控件句柄。

问题2:点击内嵌程序的窗体,则本程序的标题栏失去焦点

解决方法:不详。

问题3:点击内嵌程序的窗体,按下ALT+F4,则内嵌程序退出,仅留下本程序

解决方法:可以通过Hook方式拦截ALT+F4。

posted @ 2011-07-25 11:54  许明吉博客  阅读(6716)  评论(0编辑  收藏  举报