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 .
|