Delphi实现窗体内嵌其他应用程序窗体

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

为了美化程序的嵌入效果,需要隐藏其标题栏
在外部窗体大小变化时,需要内嵌的窗体也随之变化大小
外部程序退出时,内嵌的程序也要退出
下面是例子程序。新建窗体,上面放置一个Panel控件,名为pnlApp,然后按下面代码编写

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

为了美化程序的嵌入效果,需要隐藏其标题栏
在外部窗体大小变化时,需要内嵌的窗体也随之变化大小
外部程序退出时,内嵌的程序也要退出
下面是例子程序。新建窗体,上面放置一个Panel控件,名为pnlApp,然后按下面代码编写
}
unit frmTestEmbedApp;

interface

uses
  Windows,
 Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
 ExtCtrls, RzPanel, Vcl.StdCtrls, Vcl.Buttons,Winapi.TlHelp32;

type

  TForm1  = class(TForm)
    pnlApp: TRzPanel;
    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; //SW_SHOW;                           //true
 //windows10 xe10.3 这样用会运行打开 报错  用下面的不会,看delphi 版本而定,优先使用这种的
//CreateProcess(nil,PChar(AppFileName), nil, nil, true, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
 si, pi) 
  if not CreateProcess(PChar(AppFileName),nil, nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
 si, pi) then Exit;

  //  等待进程启动
  WaitForInputIdle(pi.hProcess, 10000);

  //  取得进程的 Handle CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pi.dwProcessID);
  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:\Program Files\internet explorer\iexplore.exe';//  // '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://www.cnblogs.com/xtfnpgy/p/9285421.html

  • 1
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值