在实现细节上需要注意几点:
为了美化程序的嵌入效果,需要隐藏其标题栏
在外部窗体大小变化时,需要内嵌的窗体也随之变化大小
外部程序退出时,内嵌的程序也要退出
下面是例子程序。新建窗体,上面放置一个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
Delphi实现窗体内嵌其他应用程序窗体
最新推荐文章于 2024-05-14 00:17:36 发布