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

实现原理是启动一个应用程序，通过ProcessID得到窗体句柄，然后对其设定父窗体句柄为本程序某控件句柄(本例是窗体内一个Panel的句柄)，这样就达成了内嵌的效果。

本文实现的是内嵌一个记事本程序，如下图：

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

在实现细节上需要注意几点：

  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。

实现原理是启动一个应用程序，通过ProcessID得到窗体句柄，然后对其设定父窗体句柄为本程序某控件句柄(本例是窗体内一个Panel的句柄)，这样就达成了内嵌的效果。

本文实现的是内嵌一个记事本程序，如下图：

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

在实现细节上需要注意几点：

  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。

相关文章：

  • 2022-12-23
  • 2022-12-23
  • 2022-12-23
  • 2022-12-23
  • 2022-12-23
  • 2021-07-04
  • 2022-12-23
  • 2022-12-23
猜你喜欢
  • 2021-11-24
  • 2022-12-23
  • 2021-11-23
  • 2021-08-12
  • 2022-12-23
相关资源
相似解决方案
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode