zoukankan      html  css  js  c++  java
  • [代码]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。

  • 相关阅读:
    SQL Server 复制订阅
    杂谈经验与未来
    泛泰A820L (高通MSM8660 cpu) 3.4内核的CM10.1(Android 4.2.2) 測试版第二版
    hdu1280 前m大的数(数组下标排序)
    Design Pattern Adaptor 适配器设计模式
    ssh命令、ping命令、traceroute 命令所使用的协议
    Android禁止ViewPager的左右滑动
    推荐一款优雅的jquery手风琴特效
    vijos
    iOS 7 UI 过渡指南
  • 原文地址:https://www.cnblogs.com/journeyonmyway/p/2113399.html
Copyright © 2011-2022 走看看