unit uembedapp;
{$mode objfpc}{$H+}
interface
uses
Windows, SysUtils, Variants, Classes;
type
// Store form information
PProcessWindow = ^TProcessWindow;
TProcessWindow = record
ProcessID: Cardinal;
FoundWindow: hWnd;
end;
function RunAppInPanel(const AppFileName: string; ParentHandle: HWND; var WinHandle: HWND): Boolean;
var
hWin: HWND = 0;
implementation
// enumerating windows proc
function EnumWindowsProc(Wnd: HWND; wInfo: Int64): BOOL; stdcall;
var
WndProcessID: Cardinal;
P: pointer;
ProcWndInfo : PProcessWindow;
begin
// typecasting wInfo to PProcessWindow ty;e
P := Pointer(wInfo);
ProcWndInfo := PProcessWindow(P);
GetWindowThreadProcessId(Wnd, @WndProcessID);
if WndProcessID = ProcWndInfo^.ProcessID then begin
ProcWndInfo^.FoundWindow := Wnd;
Result := False; // if already exists, stop EnumWindows
end
else
Result := True; // continue searching
end;
// Search handle from ProcessID
function GetProcessWindow(ProcessID: Cardinal): HWND;
var
ProcWndInfo: TProcessWindow;
begin
ProcWndInfo.ProcessID := ProcessID;
ProcWndInfo.FoundWindow := 0;
EnumWindows(@EnumWindowsProc, Integer(@ProcWndInfo)); // 查找窗体
Result := ProcWndInfo.FoundWindow;
end;
function RunAppInPanel(const AppFileName: string; ParentHandle: HWND; var WinHandle: HWND): Boolean;
var
si: STARTUPINFOA; // changed from StartupInfo to StartupInfoA
pi: TProcessInformation;
begin
Result := False;
// Start process
FillChar(si, SizeOf(si), 0); // so, this might be affected.
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;
// Wait for process to start
WaitForInputIdle(pi.hProcess, 10000);
// Get process 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;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end.
//------------------- Form unit
unit uMainform;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ButtonPanel;
type
{ TMainForm }
TMainForm = class(TForm)
ButtonPanel1: TButtonPanel;
pnlApp: TPanel;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
public
end;
var
MainForm: TMainForm;
implementation
uses
uembedapp;
{$R *.lfm}
{ TMainForm }
procedure TMainForm.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 TMainForm.FormResize(Sender: TObject);
begin
if hWin <> 0 then MoveWindow(hWin, 0, 0, pnlApp.ClientWidth, pnlApp.ClientHeight, True);
end;
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if hWin > 0 then PostMessage(hWin, WM_CLOSE, 0, 0);
end;
end.
Recent
