Delphi 实现第三方程序嵌入

WinApi:GetParent SetParent MoveWindow  获取、指定父窗口和移动窗口
提示：SetParent应该Windows.SetParent,因为TForm的父类有同名方法

定义：
{获取父窗口句柄}
GetParent(hWnd:HWND):HWND;

{指定父窗口}
SetParent(
  hWndChild:HWND;{子句柄，即当前要移动对象的句柄}
  hWndNewParent:HWND;{父句柄，即要移动到的目标对象的句柄}
)

{移动窗体}
MoveWindow(
  hWnd:HWND;  {窗口句柄}
  x,y:Integer;{位置}
  nWidthm,hHeight:integer; {大小}
  bRepaint:bool            {True表示刷新；false 表示不刷新}
):boolan;

 

{
  功能：封装对第三方程序运行启动和第三方程序运行窗口显示位置
        调整的功能
  编写：sundh
  编写时间：2018.10.25
  最后修改时间：
}
unit uSetOtherAppPostion;

interface
  uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs,shlobj,shellapi, ExtCtrls, StdCtrls,inifiles;
type
  TSetTCMSMonitor=class
    public
      {运行第三方程序并设定其运行的屏幕-多屏}
      class procedure  setMonitor(monitorIndex:Integer;ATitle:string;appName:string;appPath:string); //把制定标题的窗体移动到指定序号的屏幕上
      class procedure closeMonitor;
  end;
  TParmSet=record
    appTitle:string; //程序窗口名称
    appPath:string;//程序路径
    handle:Cardinal;//句柄
    width:integer; //宽度
    height:Integer; //高度
  end;
  TSetPosCallBack=procedure(isFinished:Boolean) of object;
  TSetPostion=class(TThread)
    private
      FControlTitle:string;
      FControlPath:string;
      FHandled:Boolean;
      FTargetHandle:Cardinal;
      FTargetWidth:Integer;
      FTargetHeight:Integer;
      FOnSetPosCallback:TSetPosCallBack;
      FtmpHandle:cardinal;
    private
      FIsCallU3D: Boolean;
      procedure fSetPostion;
      procedure ProcessSetPosCallback;
    public
      procedure execute;override;
      {关闭第三方程序，即退出程序时需要首先关闭嵌入到目标容器中的第三方程序}
      procedure CloseWindow;
      procedure CloseWindowEx;
      {运行第三方程序并设定其运行的屏幕-多屏}
//      procedure setMonitor(monitorIndex:Integer;ATitle:string;appName:string;appPath:string); //把制定标题的窗体移动到指定序号的屏幕上
      {构造方法，可通过构造方法传参也可不传参通过属性设置}
      constructor  Create(ATitle:string='';APath:string='';AHandle:cardinal=0;AWidth:Integer=0;AHeigh:Integer=0);overload;
    public
      //重新调整大小
      //aIsDoOnce: 是否执行一次
      procedure Resize(aIsDoOnce: Boolean=False);
      {控制目标程序的标题,即第三方程序运行后其显示窗口的标题}
      property ControlTitle:string read FControlTitle write FControlTitle;
      {控制目标程序的路径,即第三方程序存放的路径（全路径）}
      property ControlPath:string read FControlPath write FControlPath;
      {目标句柄,即第三方程序要植入的容器的句柄}
      property TargetHandle:Cardinal read FTargetHandle write FTargetHandle;
      {目标控件的宽度,即第三方程序要植入的容器的宽度}
      property TargetWidth:Integer read FTargetWidth write FTargetWidth;
      {目标控件的高度,即第三方程序要植入的容器的高度}
      property TargetHeight:Integer read FTargetHeight write FTargetHeight;
      {回调方法，用于通知是否已经获取制定屏幕的句柄，而且至少执行了一次置位操作}
      property OnSetPosCallback:TSetPosCallBack read FOnSetPosCallback write FOnSetPosCallback;
      //是否调用U3D
      property IsCallU3D: Boolean read FIsCallU3D write FIsCallU3D;
  end;

   TSetParent=class
     private
       FParentHandle:Cardinal;
       FChildHandle:Cardinal;
       FParentWidth:Integer;
       FParentHeight:Integer;
     public
       constructor Create;
       destructor Destroy;override;
       {设置父窗体}
       function funSetParent:Boolean;overload;
       {设置父窗体}
       function funSetParent(const parentHandle,childHandle:Cardinal;const  pwidth,pheight:Integer):Boolean;overload;
     public
       {父窗体或容器的句柄}
       property ParentHandle:Cardinal read FParentHandle write FParentHandle;
       {子窗体的句柄}
       property ChildHandle:Cardinal read FChildHandle write FChildHandle;
       {父窗体或容器的宽度}
       property ParentWidth:Integer read FParentWidth write FParentWidth;
       {父窗体或容器的高度}
       property ParentHeight:Integer read FParentHeight write FParentHeight;

   end;

  {
    功能描述：读写ini文件
    参数说明：iniPath ini文件的路径（全路径）
              section 节点
              key     键名
              value   键值
              readorwrite 读写标志 0读  1写
    编写：sundh
    编写时间：2018.10.26
  }
  procedure iniReadWrite(iniPath:string{ini文件};section:string{节点};key:string{键名};var value:string{键值};readorwrite:integer);

  var
  {机车微机屏句柄，因为程序只能启动一个机车微机屏屏程序，所以这里公用一个变量 类似P-V操作来控制}
    ahandle:Cardinal; {接口变量}
implementation

{ TSetPostion }
var
  tempHandle:Cardinal; //获取目标的句柄

procedure TSetPostion.CloseWindow;     //关闭打开窗体
begin
  if FtmpHandle > 0 then
  begin
    PostMessage(FtmpHandle, WM_CLOSE, 0, 0);
  end;
end;

procedure TSetPostion.CloseWindowEx;
begin
  if FtmpHandle > 0 then
  begin
    SetParent(FtmpHandle, 0);
    ShowWindow(FtmpHandle, SW_MINIMIZE); //最小化窗口
//    PostMessage(FtmpHandle, WM_CLOSE, 0, 0);
  end;
end;

constructor TSetPostion.Create(ATitle: string='';APath:string='';AHandle:Cardinal=0;AWidth:integer=0;AHeigh:Integer=0);
begin
  FIsCallU3D := True;
  FControlTitle:=ATitle;
  FControlPath:=APath;
  FTargetHandle:=Ahandle;
  FTargetWidth:=AWidth;
  FTargetHeight:=AHeigh;
  inherited Create(True);
end;

procedure TSetPostion.execute;
begin
  inherited;
  FreeOnTerminate:=false; //线程结束后不自动释放线程对象
  fSetPostion;  //启动设置程序
end;

procedure TSetPostion.fSetPostion;
var
  tmpHandle:Cardinal;
  label LocateWin;
begin
   tmpHandle:=0;
   tmpHandle:=FindWindow(nil,PAnsiChar(FControlTitle));
   if (tmpHandle > 0) or (FtmpHandle > 0) then   //如果目标已经启动
   begin
     if tmpHandle > 0 then
       FtmpHandle := tmpHandle;
     FHandled:=True;
//     Sleep(1000); //延时10秒钟
     //zlm 隐藏窗口标题栏
     SetWindowLong(FtmpHandle, gwl_style, getwindowlong(FtmpHandle, gwl_style) and not ws_caption);
     SetParent(FtmpHandle,FTargetHandle); //设置容器句柄
     MoveWindow(FtmpHandle,0,0,FTargetWidth,FTargetHeight,true);
     Synchronize(ProcessSetPosCallback);
     Exit;
   end
   else
   begin
     if not FIsCallU3D then
       goto LocateWin;
     if ((FileExists(FControlPath)) and (tmpHandle<=0) and ((FtmpHandle <= 0))) then  //启动目标程序
     begin
       //ShowMessage('U3D:'+ Format('FControlTitle:%s, tmpHandle=%d,  FtmpHandle=%d', [FControlTitle, tmpHandle, FtmpHandle]));
       ShellExecute(0,'open',PChar(FControlPath),'',PChar(FControlPath),SW_NORMAL);
     end;
   end;
   while (not FHandled) do
   begin
      LocateWin:
      tmpHandle:=FindWindow(nil,PAnsiChar(FControlTitle));
      if (tmpHandle > 0) or (FtmpHandle > 0) then
      begin
        if tmpHandle > 0 then
          FtmpHandle := tmpHandle;
//        Sleep(1000); //延时10秒钟
        //zlm 隐藏窗口标题栏
        SetWindowLong(FtmpHandle, gwl_style, getwindowlong(FtmpHandle, gwl_style) and not ws_caption);
        SetParent(FtmpHandle,FTargetHandle); //设置容器句柄
        MoveWindow(FtmpHandle,0,0,FTargetWidth,FTargetHeight,true);
        FHandled:=True;  //退出循环
      end;
      Sleep(10);
   end;

   Synchronize(ProcessSetPosCallback);
   FHandled:=False; // 还原状态
end;

procedure TSetPostion.ProcessSetPosCallback;
begin
  if Assigned(OnSetPosCallback) then //回调方法，通知当前状态
     OnSetPosCallback(FHandled);
end;

procedure TSetPostion.Resize(aIsDoOnce: Boolean);
begin
  if aIsDoOnce then
  begin
    if FtmpHandle = 0 then
      Exit;
    //zlm 隐藏窗口标题栏
    SetWindowLong(FtmpHandle, gwl_style, getwindowlong(FtmpHandle, gwl_style) and not ws_caption);
    SetParent(FtmpHandle, FTargetHandle); //设置容器句柄
    MoveWindow(FtmpHandle, 0, 0, FTargetWidth,FTargetHeight, True);
  end
  else
    fSetPostion;
end;

{
  功能：把标题为ATitle 的窗口移动到序号为monitorIndex的屏幕上
  ATitle:目标程序的窗口标题
  monitorIndex:目标屏幕的序号
  appName:应用程序的名称
  appPath:应用程序的路径
}
procedure iniReadWrite(iniPath:string{ini文件};section:string{节点};key:string{键名};var value:string{键值};readorwrite:integer);
var
  ini:TIniFile;
begin
  try
    if FileExists(iniPath) then
    begin
      ini:=TIniFile.Create(iniPath);
    end;
    if readorwrite=0 then
    begin
      value:=ini.ReadString(section,key,'');
    end
    else if readorwrite=1 then
    begin
      ini.WriteString(section,key,value);
    end;
  finally
    ini.Free;
  end;
end;
{ TSetTCMSMonitor }

class procedure TSetTCMSMonitor.closeMonitor;
begin
  if ahandle>0 then
     SendMessage(ahandle,WM_CLOSE,0,0); //关闭机车微机屏
  ahandle:=0;  //清空句柄变量
end;

class procedure TSetTCMSMonitor.setMonitor(monitorIndex: Integer; ATitle, appName, appPath: string);
begin
   ahandle:=FindWindow(nil,PAnsiChar(ATitle));
  if ahandle<=0 then //程序尚未启动
  begin
    if FileExists(appPath) then
       ShellExecute(0,'open',PAnsiChar(appPath),'',PAnsiChar(appPath),SW_NORMAL); //启动程序
    Sleep(2000); //延时2秒钟
    ahandle:= FindWindow(nil,PAnsiChar(ATitle));
  end;
  if ahandle>0 then
  begin
    with Screen.Monitors[monitorIndex] do
    begin
      MoveWindow(ahandle,Left-5,Top,Width+7,Height,True);
    end;
  end;
end;

{ TSetParent }

constructor TSetParent.Create;
begin
  inherited;

end;

destructor TSetParent.Destroy;
begin
  {如果子窗体没有关闭，则向子窗体发送消息，让其执行关闭动作}
  if ChildHandle>0 then  
     PostMessage(ChildHandle,WM_CLOSE,0,0);
  inherited;
end;

function TSetParent.funSetParent: Boolean;
var
  flag:Cardinal;
begin
  flag:=0;
  flag:=Windows.SetParent(ChildHandle,ParentHandle);
  if flag>0 then
  begin
     MoveWindow(ChildHandle,0,0,ParentWidth,ParentHeight,true);
     result:=True;
  end
  else
  begin
    result:=False;
  end;
end;

function TSetParent.funSetParent(const parentHandle, childHandle: Cardinal; const pwidth, pheight: Integer): Boolean;
begin
  Self.ParentHandle:=parentHandle;
  Self.ChildHandle:=childHandle;
  Self.ParentWidth:=pwidth;
  Self.ParentHeight:=pheight;
  result:=funSetParent;
end;

end.