Lazarus将其它应用程序嵌入自己的程序窗口中

测试用的是记事本程序嵌入到一个TPanel中。

1、新创建一个应用

2、创建一个单元

unit uembedapp;

{$mode objfpc}{$H+}

interface

uses
  Windows, SysUtils, Variants, Classes;

type
  //应用程序窗口信息
  PProcessWindow = ^TProcessWindow;
  TProcessWindow = record
    ProcessID: Cardinal;
    FoundWindow: hWnd;
  end;
  //参数 应用程序文件名，应用程序主窗口类名，应用程序要放在那个控件的句柄，返回应用程序窗口句柄
  function RunAppInPanel(const AppFileName,MainWinClassName: string; ParentHandle: HWND; var WinHandle: HWND): Boolean;

var
  hWin: HWND = 0;
  ClassName: string;
implementation

//使用窗口类名找窗口-------------
function EnumWindowsProc(Wnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  WndProcessID: DWORD;
  Info: PProcessWindow;
  Style: LONG_PTR;
  cls: array[0..255] of char;
  mycls:string;
begin
  Result := True;

  Info := PProcessWindow(lParam);
  if Info = nil then Exit;

  GetWindowThreadProcessId(Wnd, @WndProcessID);
  GetClassName(Wnd, cls, 255);
  mycls:=uppercase(trim(cls));
  if  mycls<> ClassName then Exit(true);
  if GetWindow(Wnd, GW_OWNER) <> 0 then  Exit;
  Style := GetWindowLongPtr(Wnd, GWL_STYLE);
  if (Style and WS_CHILD) <> 0 then Exit;

  Info^.FoundWindow := Wnd;
  Result := False;
end;

function FindProcessMainWindow(ProcessID: DWORD; TimeoutMS: DWORD = 10000): HWND;
var
  Info: TProcessWindow;
  StartTick: DWORD;
begin
  Result := 0;
  StartTick := GetTickCount64 mod High(DWORD);

  repeat
    Info.ProcessID := ProcessID;
    Info.FoundWindow := 0;
    EnumWindows(@EnumWindowsProc, LPARAM(@Info));
    if Info.FoundWindow <> 0 then Exit(Info.FoundWindow);

    Sleep(100);
  until (GetTickCount64 mod High(DWORD)) - StartTick >= TimeoutMS;
end;
//-------------------------------------------



function RunAppInPanel(const AppFileName,MainWinClassName: string; ParentHandle: HWND; var WinHandle: HWND): Boolean;
var
  si: STARTUPINFOA;
  pi: TProcessInformation;
begin
  Result := False;
  ClassName:=uppercase(MainWinClassName);
  //启动外部应用
  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 :=FindProcessMainWindow(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.

　　

 

3、在主窗口中加一个Panel1: TPanel; 主窗口代码如下

unit Unit1;

{$mode objfpc}{$H+}
{$ModeSwitch ANONYMOUSFUNCTIONS}
interface

uses
windows, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls,LazUTF8;

type
// 监控线程
TProcessMonitorThread = class(TThread)
private
FProcHandle: THandle;
FTargetForm: TForm;
protected
procedure Execute; override;
public
constructor Create(AProcHandle: THandle; AForm: TForm);
end;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
Panel1: TPanel;
Panel2: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
FMonitorThread: TProcessMonitorThread;
hProc: THandle;
public

end;

var
Form1: TForm1;

implementation
uses
uembedapp;
const
KJClassName='RICHEDIT50W';
{$R *.lfm}

{ TProcessMonitorThread }

constructor TProcessMonitorThread.Create(AProcHandle: THandle; AForm: TForm);
begin
inherited Create(True);
FProcHandle := AProcHandle;
FTargetForm := AForm;
FreeOnTerminate := True;
end;

procedure TProcessMonitorThread.Execute;
begin
// 等待进程结束
WaitForSingleObject(FProcHandle, INFINITE);

// 进程结束，通知主界面关闭
// 使用 Queue 避免死锁（如果主线程也在等待）
TThread.Queue(nil, procedure
begin
if Assigned(FTargetForm) and (FTargetForm is TForm1) then
TForm1(FTargetForm).Close;
end);

CloseHandle(FProcHandle);
end;
function GetProcessHandleFromWnd(Wnd: HWND): THandle;
var
PID: DWORD;
begin
Result := 0;
GetWindowThreadProcessId(Wnd, @PID);
if PID <> 0 then
Result := OpenProcess(SYNCHRONIZE, False, PID);
end;
{ TForm1 }

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if hWin > 0 then PostMessage(hWin, WM_CLOSE, 0, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hEdit: HWND;
Len: Integer;
EditText:string;
begin
hEdit:=FindWindowEx(hWin,0,KJClassName,nil);
if hEdit=0 then Exit;
Len := SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0);
if Len > 0 then
begin
SetLength(EditText, Len);
SendMessage(hEdit, WM_GETTEXT, Len + 1, LPARAM(PChar(EditText)));
Memo1.Text:=WinCPToUTF8(EditText);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
hEdit: HWND;
EditText:string;
begin
hEdit:=FindWindowEx(hWin,0,KJClassName,nil);
if hEdit=0 then Exit;
EditText:=UTF8ToWinCP(Memo1.Text);
SendMessage(hEdit, WM_SETTEXT, 0, LPARAM(PChar(EditText)));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
hEdit: HWND;
StartPos, EndPos: LPARAM;
EditText:string;
begin
hEdit:=FindWindowEx(hWin,0,KJClassName,nil);
if hEdit=0 then Exit;
StartPos := SendMessage(hEdit, EM_GETSEL, 0, 0);
EndPos := HiWord(StartPos);
StartPos := LoWord(StartPos);

SendMessage(hEdit, EM_SETSEL, StartPos, EndPos);

EditText:=UTF8ToWinCP(Memo1.Text);
SendMessage(hEdit, EM_REPLACESEL, 0,LPARAM(PChar(EditText)));
end;

procedure TForm1.FormCreate(Sender: TObject);
const
App = 'C:\Windows\write.exe'; //应用程序文件名
MainWinClassName='WordPadClass'; //主窗口类名
begin
Panel1.Align := alClient;
if not RunAppInPanel(App,MainWinClassName, Panel1.Handle, hWin) then ShowMessage('应用程序没找到');

hProc := GetProcessHandleFromWnd(hWin);
if hProc <> 0 then
begin
FMonitorThread := TProcessMonitorThread.Create(hProc, Self);
FMonitorThread.Start;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
if hWin <> 0 then MoveWindow(hWin, 0, 0, Panel1.ClientWidth, Panel1.ClientHeight, True);
end;

end.

运行效果

 

下一步，如何实现外部应用与主窗口交互。