Hola a todos,
Al final consegui una solucion mas o menos satisfactoria. Bueno, para muestra un bot�n, aqu� ten�is el c�digo de la clase por si a alguno le interesa:
//*******************************************COPIAR DESDE
AQUI********************************************************
unit cEmbutido;
{$mode objfpc}{$H+}
interface
uses
Classes, Forms, SysUtils, Windows, process, Controls;
type
TVentanaGuardianThread= class;
TVentanaEmbutida = class (TObject)
private
FChangedParent: boolean;
FClase: string;
FClaseClick: string;
FClicked: boolean;
FHandle: THANDLE;
FHandleClick: THANDLE;
FTitulo: string;
FTituloClick: string;
public
property Clase: string read FClase write FClase;
property Titulo: string read FTitulo write FTitulo;
property Handle: THANDLE read FHandle write FHandle;
property ChangedParent: boolean read FChangedParent write
FChangedParent;
property ClaseClick: string read FClaseClick write FClaseClick;
property TituloClick: string read FTituloClick write FTituloClick;
property HandleClick: THANDLE read FHandleClick write FHandleClick;
property Clicked: boolean read FClicked write FClicked;
end;
TNuevaVentanaEvent = procedure(Sender: TObject; Ventana:
TVentanaEmbutida) of object;
TTerminateStatus = (tsError, tsClose, tsTerminate);
TEmbutido = class (TObject)
private
FExecName: string;
FNewParent: TWinControl;
FOnNuevaVentana: TNuevaVentanaEvent;
FOnWindowCaptured: TNuevaVentanaEvent;
FParamExec: TStringList;
FVentanasEmbutidas: TList;
FPID: integer;
FProceso: TProcess;
FVentanaGuardianThread: TVentanaGuardianThread;
FOldResize: TNotifyEvent;
procedure NuevaVentana(Sender: TObject; Ventana: TVentanaEmbutida);
procedure ChangeParent(WindowsHandle: THandle);
procedure SetNewParent(AValue: TWinControl);
procedure Resize(Sender: TObject);
property OnNuevaVentana: TNuevaVentanaEvent read FOnNuevaVentana
write FOnNuevaVentana;
function Kill(ProcessID: DWORD; Timeout: Integer = MAXINT):
TTerminateStatus;
public
constructor Create();
destructor Destroy();override;
function Run(): boolean;
function Stop(Clear: boolean): boolean;
procedure AddVentana(Ventana: TVentanaEmbutida);overload;
procedure AddVentana(Clase, Titulo: string);overload;
procedure AddVentana(Clase, Titulo, ClaseClick, TituloClick:
string);overload;
property ExecName: string read FExecName write FExecName;
property ParamExec: TStringList read FParamExec;
property PID: integer read FPID write FPID;
property NewParent: TWinControl read FNewParent write SetNewParent;
property VentanasEmbutidas: TList read FVentanasEmbutidas write
FVentanasEmbutidas;
property OnWindowCaptured: TNuevaVentanaEvent read
FOnWindowCaptured write FOnWindowCaptured;
end;
TVentanaGuardianThread = class(TThread)
public
MustDie: boolean;
Owner: TEmbutido;
protected
procedure CallEvent;
procedure Execute; override;
published
property Terminated;
end;
implementation
function EnumProcess(hHwnd: HWND; lParam: LPARAM): LongBool;stdcall;
var
pPid : DWORD;
title,
ClassName : string;
n: integer;
CurrentVentana: TVentanaEmbutida;
Propietario: TEmbutido;
begin
Result:=false;
if lParam=0 then
begin
exit;
end;
Propietario:=TEmbutido(lParam);
//Si returna NULL entonces fallo
Result:=not (hHwnd=NULL);
if not Result then
begin
exit;
end
else
begin
if not IsWindowVisible(hHwnd) then
begin
exit;
end;
//Cojo el PID de la ventana
GetWindowThreadProcessId(hHwnd,pPid);
//Asigno memoria para recibir el classname del proceso
SetLength(ClassName, 255);
//Asigno el ClassName y ajusto la cadena
SetLength(ClassName,
GetClassName(hHwnd,
PChar(className),
Length(className)));
//Asigno memoria para recibir el titulo del proceso
SetLength(title, 255);
//Asigno el titulo y ajusto la cadena
SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
//Convierto el titulo de ansi a utf8 por si tuviera acentos o
cualquier caracter no ASCII
title:=AnsiToUtf8(title);
//Compruebo el PID
if (pPid=Propietario.PID) then
begin
for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
begin
//if Propietario.ExecName='C:\Documents and
Settings\xx\Escritorio\MK_GPXTool_1.3.3\MK_GPXTool.exe' then
//begin
// Propietario.ExecName:=Propietario.ExecName+'';
//end;
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
if ClassName=CurrentVentana.Clase then
begin
if CurrentVentana.Titulo='' then
begin
CurrentVentana.Handle:=hHwnd;
end
else
begin
if CurrentVentana.Titulo=title then
begin
CurrentVentana.Handle:=hHwnd;
end;
end;
end;
end;
end
else
begin
//No no es mi PID miro si hay alguna ventana embutida sin clase
definida
for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
begin
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
if CurrentVentana.Clase='' then
begin
if CurrentVentana.Titulo=title then
begin
//Encontre la ventana
CurrentVentana.Handle:=hHwnd;
//Sustituyo el PID por el nuevo PID
Propietario.PID:=pPid;
end;
end;
end;
end;
end;
end;
function EnumChildProc(hHwnd: HWND; lParam : LPARAM): LongBool; stdcall;
var
pPid : DWORD;
title,
ClassName : string;
n: integer;
CurrentVentana: TVentanaEmbutida;
Propietario: TEmbutido;
begin
Result:=false;
if lParam=0 then
begin
exit;
end;
Propietario:=TEmbutido(lParam);
Result:=not (hHwnd=NULL);
if not Result then
begin
exit;
end
else
begin
GetWindowThreadProcessId(hHwnd,pPid);
SetLength(ClassName, 255);
SetLength(ClassName,
GetClassName(hHwnd,
PChar(className),
Length(className)));
SetLength(title, 255);
SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
if (pPid=Propietario.PID) then
begin
for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
begin
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
if (ClassName=CurrentVentana.ClaseClick) and
(title=CurrentVentana.TituloClick) then
begin
CurrentVentana.HandleClick:=hHwnd;
end;
end;
end;
Result := true;
end;
end;
procedure TVentanaGuardianThread.CallEvent;
var
aVentana: TVentanaEmbutida;
n: integer;
begin
if Assigned(Owner.FOnNuevaVentana) then
begin
for n:=0 to Owner.VentanasEmbutidas.Count-1 do
begin
aVentana:=TVentanaEmbutida(Owner.VentanasEmbutidas[n]);
if (aVentana.Handle>0) and (not aVentana.ChangedParent) then
begin
Owner.FOnNuevaVentana(Owner,aVentana);
end;
end;
end;
end;
procedure TVentanaGuardianThread.Execute;
begin
try
while not MustDie do
begin
EnumWindows(@EnumProcess,LPARAM(Owner));
Synchronize(@CallEvent);
end;
finally
Terminate;
end;
end;
procedure TEmbutido.NuevaVentana(Sender: TObject; Ventana:
TVentanaEmbutida);
function MouseClick(x: DWORD; y: DWORD): DWORD;
var
P: TPoint;
begin
GetCursorPos(P); // Guardo las coordenadas del mouse
SetCursorPos(x, y);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0); // Press
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); // Release
SetCursorPos(P.x, P.y); // Restauro las coordenadas del Mouse
end;
var
Rectangulo: TRect;
begin
ChangeParent(Ventana.Handle);
Ventana.ChangedParent:=true;
FNewParent.SetFocus;
if Ventana.ClaseClick'' then
begin
EnumChildWindows(Ventana.Handle, en EnumChildProc,LPARAM(self));
if Ventana.HandleClick>0 then
begin
GetWindowRect(Ventana.HandleClick,Rectangulo);
MouseClick(Rectangulo.Left+2,Rectangulo.Top+2);
end;
end;
if Assigned(FOnWindowCaptured) then
begin
FOnWindowCaptured(self,Ventana);
end;
end;
procedure TEmbutido.ChangeParent(WindowsHandle: THandle);
var
WindowsStyle,
FAppThreadID: LongInt;
begin
WindowsStyle:=GetWindowLong(WindowsHandle,GWL_STYLE);
WindowsStyle:=WindowsStyle-WS_CAPTION-WS_BORDER-WS_OVERLAPPED-WS_THICKFRAME;
SetWindowLong(WindowsHandle,GWL_STYLE,WindowsStyle);
FAppThreadID:=GetWindowThreadProcessId(WindowsHandle,nil);
AttachThreadInput(GetCurrentThreadId,FAppThreadID,true);
windows.SetParent(WindowsHandle,NewParent.Handle);
SendMessage(NewParent.Handle,WM_UPDATEUISTATE,UIS_INITIALIZE,0);
UpdateWindow(WindowsHandle);
SetWindowLong(NewParent.Handle,GWL_STYLE,
GetWindowLong(NewParent.Handle, GWL_STYLE) or WS_CLIPCHILDREN);
SetWindowPos(WindowsHandle,0,0,0,NewParent.Width,NewParent.Height,SWP_NOZORDER);
SetForegroundWindow(WindowsHandle);
MoveWindow(WindowsHandle,0,0,NewParent.Width,NewParent.Height,true);
end;
procedure TEmbutido.SetNewParent(AValue: TWinControl);
begin
if FNewParent=AValue then
begin
exit;
end;
if FNewParentnil then
begin
//Libero el onresize del parent antiguo
FNewParent.OnResize:=FOldResize;
end;
FNewParent:=AValue;
FOldResize:=FNewParent.OnResize;
;
end;
procedure TEmbutido.Resize(Sender: TObject);
var
n: integer;
CurrentVentana: TVentanaEmbutida;
begin
for n:=0 to FVentanasEmbutidas.Count-1 do
begin
CurrentVentana:=TVentanaEmbutida(FVentanasEmbutidas[n]);
if (CurrentVentana.Handle>0) and (CurrentVentana.ChangedParent) then
begin
MoveWindow(CurrentVentana.Handle,0,0,FNewParent.Width,FNewParent.Height,true);
end;
end;
if Assigned(FOldResize) then
begin
FOldResize(Sender);
end;
end;
function EnumWindowsProc(hHwnd: HWND; lParam: LPARAM): LongBool;stdcall;
var
PID: DWORD;
begin
GetWindowThreadProcessId(hHwnd, @PID);
if lParam=PID then
begin
PostMessage(hHwnd,WM_CLOSE,0,0);
end;
Result:=True;
end;
function TEmbutido.Kill(ProcessID: DWORD; Timeout: Integer
): TTerminateStatus;
var
ProcessHandle: THandle;
begin
Result:=tsError;
if ProcessIDGetCurrentProcessId then
begin
ProcessHandle:=OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False,
ProcessID);
try
if ProcessHandle0 then
begin
if Timeout>=0 then
begin
EnumWindows(@EnumWindowsProc,FPID);
if WaitForSingleObject(ProcessHandle,Timeout)=WAIT_OBJECT_0 then
Result:=tsClose
else
if TerminateProcess(ProcessHandle,0) then
Result:=tsTerminate;
end
else
if TerminateProcess(ProcessHandle,0) then
Result:=tsTerminate;
end;
finally
CloseHandle(ProcessHandle);
end;
end;
end;
constructor TEmbutido.Create;
begin
FVentanasEmbutidas:=TList.Create;
FParamExec:=TStringList.Create;
FProceso:=TProcess.Create(nil);
FVentanaGuardianThread:=TVentanaGuardianThread.Create(true);
FVentanaGuardianThread.Owner:=self;
FVentanaGuardianThread.MustDie:=false;
;
FNewParent:=nil;
FPID:=0;
end;
destructor TEmbutido.Destroy;
begin
if FVentanaGuardianThreadnil then
begin
FVentanaGuardianThread.FreeOnTerminate:=false;
FVentanaGuardianThread.MustDie:= true;
if FPID>0 then
begin
while not FVentanaGuardianThread.Terminated do
begin
Application.ProcessMessages;
end;
end;
FVentanaGuardianThread.Free;
FVentanaGuardianThread:=nil;
end;
if FPID>0 then
begin
Kill(FPID,10);
end;
FVentanasEmbutidas.Clear;
FVentanasEmbutidas.Free;
FProceso.Free;
FParamExec.Free;
inherited Destroy;
end;
function TEmbutido.Run: boolean;
begin
FProceso.Executable:=ExecName;
FProceso.Parameters.Assign(FParamExec);
FProceso.Execute;
FPID:=FProceso.ProcessID;
FVentanaGuardianThread.Start;
end;
function TEmbutido.Stop(Clear: boolean): boolean;
var
n: integer;
Ventana: TVentanaEmbutida;
begin
Result:=(Kill(FPID,10)tsError);
if Clear then
begin
for n:=0 to FVentanasEmbutidas.Count-1 do
begin
TVentanaEmbutida(FVentanasEmbutidas[n]).Free;
end;
FVentanasEmbutidas.Clear;
FParamExec.Clear;
end
else
begin
for n:=0 to FVentanasEmbutidas.Count-1 do
begin
Ventana:=TVentanaEmbutida(FVentanasEmbutidas[n]);
Ventana.Handle:=0;
Ventana.ChangedParent:=false;
Ventana.HandleClick:=0;
Ventana.Clicked:=false;
end;
end;
end;
procedure TEmbutido.AddVentana(Ventana: TVentanaEmbutida);
begin
Ventana.Handle:=0;
Ventana.ChangedParent:=false;
Ventana.HandleClick:=0;
Ventana.Clicked:=false;
FVentanasEmbutidas.Add(Ventana);
end;
procedure TEmbutido.AddVentana(Clase, Titulo: string);
begin
AddVentana(Clase,Titulo,'','');
end;
procedure TEmbutido.AddVentana(Clase, Titulo, ClaseClick, TituloClick:
string);
var
TempVentana: TVentanaEmbutida;
begin
TempVentana:=TVentanaEmbutida.Create;
TempVentana.Clase:=Clase;
TempVentana.Titulo:=Titulo;
TempVentana.Handle:=0;
TempVentana.ChangedParent:=false;
TempVentana.ClaseClick:=ClaseClick;
TempVentana.TituloClick:=TituloClick;
TempVentana.HandleClick:=0;
TempVentana.Clicked:=false;
AddVentana(TempVentana);
end;
end.
//*******************************************HASTA
AQUI********************************************************
Para abrir google earth y embutir su ventana seria algo como:
Embutido.ExecName:='C:\Archivos de programa\Google\Google
Earth\client\googleearth.exe';
Embutido.AddVentana('QWidget','Google Earth');
;
Embutido.Run();
Espero os sirva.
Saludos.
