当前位置: 首页 > 技术文档 > 正文

实现原理是启动一个应用程序,通过ProcessID得到窗体句柄,然后对其设定父窗体句柄为本程序某控件句柄(本例 […]

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

本文实现的是内嵌一个记事本程序,如下图:
201107212347373243

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

•为了美化程序的嵌入效果,需要隐藏其标题栏
•在外部窗体大小变化时,需要内嵌的窗体也随之变化大小
•外部程序退出时,内嵌的程序也要退出
下面是例子程序。新建窗体,上面放置一个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。

——————–未整理—————————–

本文固定链接: https://blog.meyisi.cn/jishu/613.html | 么意思博客
标签:

Delphi实现窗体内嵌其他程序窗体:等您坐沙发呢!

发表评论

快捷键:Ctrl+Enter