Tengo el siguiente código que es para abrir un ejecutable en un exe.
Option Explicit
Private Declare Function GetGUIThreadInfo Lib "user32.dll" ( _
ByVal idThread As Long, _
ByRef pgui As GUITHREADINFO) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function GetAncestor Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal gaFlags As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
(ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Boolean, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, ByVal _
lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type GUITHREADINFO
cbSize As Long
flags As Long
hwndactive As Long
hwndFocus As Long
hwndCapture As Long
hwndMenuOwner As Long
hwndMoveSize As Long
hwndcaret As Long
rcCaret As RECT
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Const GA_PARENT = 1
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40
Private udtGUI As GUITHREADINFO
Private udtProc As PROCESS_INFORMATION
Private Function StartProcess(strProgram As String) As Long
Dim udtStartup As STARTUPINFO
Dim udtSec As SECURITY_ATTRIBUTES
Dim lngReturn As Long
udtStartup.cb = Len(udtStartup)
udtSec.nLength = Len(udtSec)
udtSec.bInheritHandle = True
'
' Start the process
'
lngReturn = CreateProcess(strProgram, vbNullString, udtSec, udtSec, _
True, ByVal 0, ByVal 0, vbNullString, _
udtStartup, _
udtProc)
txtProcess.Text = Hex(udtProc.dwThreadId)
lngReturn = GetAncestor(udtProc.hProcess, GA_PARENT)
txtParent.Text = Hex(lngReturn)
udtGUI.cbSize = Len(udtGUI)
'
' Wait for an hWnd to be allocated
'
Do
lngReturn = GetGUIThreadInfo(udtProc.dwThreadId, udtGUI)
DoEvents
Loop Until udtGUI.hwndactive <> 0
StartProcess = udtGUI.hwndactive
End Function
Private Sub PositionWindow(hwnd As Long)
Dim lngReturn As Long
lngReturn = SetWindowPos(hwnd, hwnd, 250&, 0&, 250&, 250&, SWP_NOZORDER Or SWP_SHOWWINDOW)
End Sub
Private Sub cmdIE_Click()
Dim lngReturn As Long
Dim strProg As String
strProg = "C:\Program Files (x86)\FileZilla FTP Client\filezilla.exe"
lngReturn = StartProcess(strProg)
End Sub
Private Sub Command1_Click()
'
' Change the Parent
'
Dim lngReturn As Long
Dim lngStyle As Long
lngReturn = SetParent(udtGUI.hwndactive, Me.hwnd)
Call PositionWindow(udtGUI.hwndactive)
lngReturn = GetAncestor(udtGUI.hwndactive, GA_PARENT)
txtParent.Text = Hex(lngReturn)
End Sub
Private Sub Form_Load()
txtMe.Text = Hex(Me.hwnd)
'
' Scalemode = Pixel
'
Me.ScaleMode = 3
End Sub
Y efectivamente hace lo que yo quiero, abre un programa dentro del formulario, lo probé con la calculadora de Windows e incluso con otros programas
(http://gamerzfox.com/ccccccccc.jpg)
Pero lo que no entiendo es por qué no pasa lo mismo con Chrome, me refiero a que lo abre en una nueva ventana mas no dentro del formulario.
Me urge terminarlo cuanto antes, espero puedan ayudarme, muchas gracias!
no será porque chrome crea un proceso base y abre un proceso hijo por ventana? tendrías que capturar todos los childs de chrome... si te fijas en el administrador de taréas el siempre abre unas 2 o 3 instancias y luego una por ventana más otras por los flash y "accesorios"
Cita de: engel lex en 1 Febrero 2015, 00:04 AM
no será porque chrome crea un proceso base y abre un proceso hijo por ventana? tendrías que capturar todos los childs de chrome... si te fijas en el administrador de taréas el siempre abre unas 2 o 3 instancias y luego una por ventana más otras por los flash y "accesorios"
Hola compañero, gracias por tu respuesta...
Es lógico lo que me dices y tienes razón cuando lo vi en el administrador de tareas, pero creer que haya alguna forma de hacerlo modificando el código que tengo, es posible?
lo siento... solo di una respuesta racional con respecto al problema... pero realmente no se sobre visual basic... esperemos que pase un conocedor de estos temas ;D
Alguien podría ayudarme, por favor. Aún no puedo dar con la solución :(
Hola
Me resultó interesante tu idea. Así que he estado trabajando un poquillo en el tema. A mi me funciona:
- Crea un Picture (que sea un poco grande)
- Crea un CommandButton
-Intruduce el siguiente código en un form
'//Funciones API para incrustar el programa en el picture
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
ByVal hWndParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Const SHOWMAXIMIZED_eSW = 3&
'//Funciones API para obtener el handle de la aplicación que queremos meter en un picture
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&
'ClassName Chrome
'Chrome_RenderWidgetHostHWND <---hijo
'Chrome_WidgetWin_1 <----Padre
Private Sub Command1_Click()
Dim hwnd As Long
' "C:\Program Files\Google\Chrome\Application\chrome.exe", vbHide 'No sirve
ShellExecute Me.hwnd, "Open", "C:\Program Files\Google\Chrome\Application\chrome.exe", _
"www.elhacker.net", "", 1
Espera (5) 'Espera cinco segundos a que se cargue
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
Call SetParent(hwnd, Picture1.hwnd) 'Meter la apcliación en el picture
Call ShowWindow(hwnd, SHOWMAXIMIZED_eSW) 'Lo ajusta al cuadro
End Sub
Private Sub Espera(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Private Sub Cerrar_Google(hwnd As Long)
If hwnd <> 0 Then
Call SetParent(hwnd, 0) ' Libera el programa
Call SendMessage(hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) 'Cierra el programa
hwnd = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End Sub
NOTA IMPORTANTE:
Tan sólo hay un problemilla. Cuando le des al botón, Chrome se iniciará pero fuera de form, pasado un par de segundos se introduce en el form. Lo suyo sería iniciarlo en modo hide (oculto) y luego volverlo a hacer visible. Estoy mirando a ver, el shell "programa", vbhide, no funciona.
La ventaja que tiene usar ShellExecute es que puedes elegir la URL que quieres que muestre
Si usas 64Bits, la dirección del programa debes cambiarla a "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" y bueno ya tu ya sabes, el directorio debe ser el que tu tengas en tu compu o sea
Saludos
Hola @okik , probé tu código y funciona perfecto. Tengo una duda, ¿Es posible detectar automáticamente la Ruta de Chrome, sin necesidad de que el usuario busque la ruta, en mi caso es "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"?, me preguntaba si hay alguna forma de detectar la ruta de chrome.exe automáticamente.
Muchas gracias nuevamente.
Cita de: NsTeam en 3 Febrero 2015, 21:54 PM
Hola @okik , probé tu código y funciona perfecto. Tengo una duda, ¿Es posible detectar automáticamente la Ruta de Chrome, sin necesidad de que el usuario busque la ruta, en mi caso es "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"?, me preguntaba si hay alguna forma de detectar la ruta de chrome.exe automáticamente.
Muchas gracias nuevamente.
Si claro que se puede. Se me ocurren varias maneras.
Pero antes de nada permíteme corregir unas líneas del código que te he dado antes. Hice un copia y pega de mi propio código en
Form_Unload y se han colado un par de líneas que no tienen utilidad ahí, se trata de la variable
hWndChild que fue un intento de introducir sólamente la Web en el Picture, funcionaba con el Notepad por ejemplo, pero no con Google Chrome. Lo borré en otras partes del código, pero no en el Form_Load, se me pasó. También está lo de Espera(5) que si que es necesario más arriba, porque hay que esperar a que se cargue Google Chrome antes de introducirlo en el Picture, pero para cerrar no hace falta.
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
Dim hWndChild As Long '<---- BORRAR ESTA LÍNEA
'Espera (5) '<---- BORRAR ESTA LÍNEA
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End SubDebería ser así:
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End SubEn cuanto a lo de
- Primera opción: Crear un código de busqueda de Chrome.exe y obtener su directorio (ideal para programas que al actualizarse van cambiando la ubicación) por ejemplo si fuera "\Google\Chrome\Application\
V0014\Chrome.exe" y al actualizarse cambiara a "\Google\Chrome\Application\V
00321\Chrome.exe". Que no es el caso. Te lo digo por si alguna vez te encuentras alguna cosa así.
- Segunda opción: Obtener mediante la función
Environ el directorio de \program files\ del sistema:
Private Sub Command1_Click()
Print Environ("programfiles")
End Sub
y luego añades el resto "\Google\Chrome\Application\chrome.exe"
Print Environ("programfiles") & "\Google\Chrome\Application\chrome.exe"- Tercera opción: accediendo al registro de windows
Cita de: okik en 4 Febrero 2015, 13:53 PM
Si claro que se puede. Se me ocurren varias maneras.
Pero antes de nada permíteme corregir unas líneas del código que te he dado antes. Hice un copia y pega de mi propio código en Form_Unload y se han colado un par de líneas que no tienen utilidad ahí, se trata de la variable hWndChild que fue un intento de introducir sólamente la Web en el Picture, funcionaba con el Notepad por ejemplo, pero no con Google Chrome. Lo borré en otras partes del código, pero no en el Form_Load, se me pasó. También está lo de Espera(5) que si que es necesario más arriba, porque hay que esperar a que se cargue Google Chrome antes de introducirlo en el Picture, pero para cerrar no hace falta.
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
Dim hWndChild As Long '<---- BORRAR ESTA LÍNEA
'Espera (5) '<---- BORRAR ESTA LÍNEA
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End Sub
Debería ser así:
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End Sub
En cuanto a lo de
- Primera opción: Crear un código de busqueda de Chrome.exe y obtener su directorio (ideal para programas que al actualizarse van cambiando la ubicación) por ejemplo si fuera "\Google\Chrome\Application\V0014\Chrome.exe" y al actualizarse cambiara a "\Google\Chrome\Application\V00321\Chrome.exe". Que no es el caso. Te lo digo por si alguna vez te encuentras alguna cosa así.
- Segunda opción: Obtener mediante la función Environ el directorio de \program files\ del sistema:
Private Sub Command1_Click()
Print Environ("programfiles")
End Sub
y luego añades el resto "\Google\Chrome\Application\chrome.exe"
Print Environ("programfiles") & "\Google\Chrome\Application\chrome.exe"
- Tercera opción: accediendo al registro de windows
Sin hardcodear:
GetModuleFileName(NULL, EXEFullPath, MAX_PATH);
El NULL es el baseaddress, yo lo llamo desde un hook (DLL) y cuando pasa por una función mia, estoy seguro que es del thread del mismo exe y no de mi thread de la DLL.
PD: éso si está en ejecución, de lo contrario es fijarse en el Registro en donde está la lista de todos los programas instalados.
Cita de: Miseryk en 4 Febrero 2015, 14:22 PM
Sin hardcodear:
GetModuleFileName(NULL, EXEFullPath, MAX_PATH);
El NULL es el baseaddress, yo lo llamo desde un hook (DLL) y cuando pasa por una función mia, estoy seguro que es del thread del mismo exe y no de mi thread de la DLL.
PD: éso si está en ejecución, de lo contrario es fijarse en el Registro en donde está la lista de todos los programas instalados.
¿Sin hardcodear? jajaja, ¿Eso está en el diccionario? ¿Qué significa? Es igual, lo supongo :P
"sin hardcodear" otra forma que hay de obtener el /Program files/ del sistema que tenía por ahí guardada y que estaba buscando es esta:
Private Sub Command1_Click()
Dim X As Variant
Dim Y As Variant
Set X = CreateObject("Wscript.Shell")
Set Y = X.Environment("Process")
Print Y("PROGRAMFILES")
End SubEn cuanto a lo que has posteado Miseryk , lo de GetModuleHandle no lo he probado y no se muy bien como va. He probado lo siguiente:
Dim hModule%, Buffer$, Length%, Msg$
hModule% = GetModuleHandle("notepad.exe")
Buffer$ = Space$(255)
Length% = GetModuleFileName(hModule%, Buffer$, Len(Buffer$))
Buffer$ = Left$(Buffer$, Length%)
Msg$ = Buffer$
Msgbox Msg$:
Pero me da el directorio de VB6.EXE y no el del notepad.exe en este caso, ni siquiera estando en ejecución. He probado sustituyendo hModule% por el hande de la aplicación (en ejecución). Pero nada, que tampoco.
Al usar NULL supongo que tu vas por C++ y no VB, ya que NULL no es válido en VB6, en sustitución sería
vbNull
la rurta del chrome esta en:
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome
o en 64 bits:
HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome
Cita de: okik en 4 Febrero 2015, 13:53 PM
Si claro que se puede. Se me ocurren varias maneras.
Pero antes de nada permíteme corregir unas líneas del código que te he dado antes. Hice un copia y pega de mi propio código en Form_Unload y se han colado un par de líneas que no tienen utilidad ahí, se trata de la variable hWndChild que fue un intento de introducir sólamente la Web en el Picture, funcionaba con el Notepad por ejemplo, pero no con Google Chrome. Lo borré en otras partes del código, pero no en el Form_Load, se me pasó. También está lo de Espera(5) que si que es necesario más arriba, porque hay que esperar a que se cargue Google Chrome antes de introducirlo en el Picture, pero para cerrar no hace falta.
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
Dim hWndChild As Long '<---- BORRAR ESTA LÍNEA
'Espera (5) '<---- BORRAR ESTA LÍNEA
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End Sub
Debería ser así:
Private Sub Form_Unload(Cancel As Integer)
Dim hwnd As Long
hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
Call Cerrar_Google(hwnd) 'cierra Google
End Sub
En cuanto a lo de
- Primera opción: Crear un código de busqueda de Chrome.exe y obtener su directorio (ideal para programas que al actualizarse van cambiando la ubicación) por ejemplo si fuera "\Google\Chrome\Application\V0014\Chrome.exe" y al actualizarse cambiara a "\Google\Chrome\Application\V00321\Chrome.exe". Que no es el caso. Te lo digo por si alguna vez te encuentras alguna cosa así.
- Segunda opción: Obtener mediante la función Environ el directorio de \program files\ del sistema:
Private Sub Command1_Click()
Print Environ("programfiles")
End Sub
y luego añades el resto "\Google\Chrome\Application\chrome.exe"
Print Environ("programfiles") & "\Google\Chrome\Application\chrome.exe"
- Tercera opción: accediendo al registro de windows
Al final entonces quedaría así
ShellExecute Me.hwnd, "Open", Environ("programfiles") & "\Google\Chrome\Application\chrome.exe", _
"www.elhacker.net", "", 1Gracias, eres un genio!.
Cita de: okik en 4 Febrero 2015, 15:13 PM
¿Sin hardcodear? jajaja, ¿Eso está en el diccionario? ¿Qué significa? Es igual, lo supongo :P
"sin hardcodear" otra forma que hay de obtener el /Program files/ del sistema que tenía por ahí guardada y que estaba buscando es esta:
Private Sub Command1_Click()
Dim X As Variant
Dim Y As Variant
Set X = CreateObject("Wscript.Shell")
Set Y = X.Environment("Process")
Print Y("PROGRAMFILES")
End Sub
En cuanto a lo que has posteado Miseryk , lo de GetModuleHandle no lo he probado y no se muy bien como va. He probado lo siguiente:
Dim hModule%, Buffer$, Length%, Msg$
hModule% = GetModuleHandle("notepad.exe")
Buffer$ = Space$(255)
Length% = GetModuleFileName(hModule%, Buffer$, Len(Buffer$))
Buffer$ = Left$(Buffer$, Length%)
Msg$ = Buffer$
Msgbox Msg$:
Pero me da el directorio de VB6.EXE y no el del notepad.exe en este caso, ni siquiera estando en ejecución. He probado sustituyendo hModule% por el hande de la aplicación (en ejecución). Pero nada, que tampoco.
Al usar NULL supongo que tu vas por C++ y no VB, ya que NULL no es válido en VB6, en sustitución sería vbNull
Bueno, como en internet son todos unos perdedores de *****, me imaginé que el path debía estar adentro de cada EXE, y por lo que pude ver en todos los programas abiertos en W7 32 bits, encontré un addres que contiene el path el cual es: (FUNCIONA CON EL 90% de los programas como OPERA, WINAMP, VB6, la ***** del McAfee, etc), también por lo que pude ver es que si abrís un proyecto de VB6, te toma el path de donde se abrió ese proyecto, muy loco, pero sinó vá a mostrar lo que vos andás buscando.
kernel32.dll+C6320 (UNICODE)
Agregala al cheatengine y andá attachando cada EXE y vás a ver que se carga el path de ese EXE. (Y)
PD: en algunos EXEs del systema no toma el path, pero funcionó con Winlogon y demás.
PD2: si el programa está hecho con una dll en especial, también hay un path con el que funciona el cual es:
msvcrt.dll+A3878 (MULTIBYTE)
PD3: el que quiera ayudar es bienvenido xDDDD la verdad que no me lo puse a ver bien, habría que investigar como funciona el taskmgr y copiar su funcionalidad.
Saludos.
Por cierto, mi GetModuleFileName no falla, porque se está llamando desde el mismo programa, seguramente GetModuleFileName debe leer la posición de memoria local en relación a ese HMODULE, por éso nunca va a leer otro programa. Cuando llegue a casa veo este tema.
Hola,
Esta idea de meter una aplicación dentro de un form, me ha venido genial para un viejo programa de inglés que tengo que requiere ejecutarse a pantalla completa y una resolución de 640x480, tapándome la barra de tareas de windows. El programa se veía en un cuadrito en el centro de la pantalla y el resto en negro, a no ser que redujese la resolución. Así que gracias.
En cuanto al código que puse he visto fallos. Por ejemplo al cerrar la aplicación también se cerraban todas las ventanas de Chrome, la de dentro del form y las que estaban fuera si era el caso. Se debe a que valor del handle no es público. También ocurre que al utilizar ShowWindow se genera un error de visualización si la última vez que se cerró Chrome estaba en modo Normal. Lo he sustituido por SetWindowPos.
Aquí dejo el código algo mejorado:
'Nombres de clase (ClassName) de Chrome
'Chrome_WidgetWin_1 <---Padre
'Chrome_RenderWidgetHostHWND <---hijo
'//Funciones API para incrustar la aplicación en el picture
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal HWNDParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
'//Funcion API para obtener el handle de la aplicación que se quiere menter en el Picture
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'//Función para cerrar la aplicación incrustada
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const SHOW_FULLSCREEN = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3
Const SWP_NOZORDER = &H4
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&
'//////////////////////////////////////////////
'//'Variable para el handle padre de Chrome //
'//Debe ser variable pública para que al //
'//cerrar el form únicamente se cierre el //
'//chrome incrustado en el picture y no //
'//otra ventana externa de chrome /////
Dim HWNDParent As Long
'//////////////////////////////////////////////
Private Sub Command1_Click()
ShellExecute Me.hwnd, "", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (5) 'Espera cinco segundos a que se cargue
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
Call SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub
Private Sub Espera(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Private Sub Cerrar_Chrome(hwnd As Long)
If HWNDParent <> 0 Then
Call SetParent(HWNDParent, 0) ' Libera el programa
Call SendMessage(HWNDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) 'Cierra el programa
HWNDParent = 0
End If
End Sub
Private Sub Form_Load()
Picture1.ScaleMode = 3 'pixels <-importante para mover _
y establecer correctamente las dimensiones de la ventana _
de chrome dentro del picture
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End Sub
El handle (hwnd) o 'asa' es un número aleatorio que Windows asigna a cada ventana que se abre en el escritorio. Se pueden cambiar características o enviar mensajes a dichas ventanas usando ese número. Como se ha podido ver con SetWindowPos, SetParent, SendMessage y ShowWindow.
Nuevamente, muchas gracias!, me anda a la perfección!
Cita de: okik en 7 Febrero 2015, 12:19 PM
Hola,
Esta idea de meter una aplicación dentro de un form, me ha venido genial para un viejo programa de inglés que tengo que requiere ejecutarse a pantalla completa y una resolución de 640x480, tapándome la barra de tareas de windows. El programa se veía en un cuadrito en el centro de la pantalla y el resto en negro, a no ser que redujese la resolución. Así que gracias.
En cuanto al código que puse he visto fallos. Por ejemplo al cerrar la aplicación también se cerraban todas las ventanas de Chrome, la de dentro del form y las que estaban fuera si era el caso. Se debe a que valor del handle no es público. También ocurre que al utilizar ShowWindow se genera un error de visualización si la última vez que se cerró Chrome estaba en modo Normal. Lo he sustituido por SetWindowPos.
Aquí dejo el código algo mejorado:
'Nombres de clase (ClassName) de Chrome
'Chrome_WidgetWin_1 <---Padre
'Chrome_RenderWidgetHostHWND <---hijo
'//Funciones API para incrustar la aplicación en el picture
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal HWNDParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
'//Funcion API para obtener el handle de la aplicación que se quiere menter en el Picture
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'//Función para cerrar la aplicación incrustada
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const SHOW_FULLSCREEN = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3
Const SWP_NOZORDER = &H4
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&
'//////////////////////////////////////////////
'//'Variable para el handle padre de Chrome //
'//Debe ser variable pública para que al //
'//cerrar el form únicamente se cierre el //
'//chrome incrustado en el picture y no //
'//otra ventana externa de chrome /////
Dim HWNDParent As Long
'//////////////////////////////////////////////
Private Sub Command1_Click()
ShellExecute Me.hwnd, "", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (5) 'Espera cinco segundos a que se cargue
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
Call SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub
Private Sub Espera(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Private Sub Cerrar_Chrome(hwnd As Long)
If HWNDParent <> 0 Then
Call SetParent(HWNDParent, 0) ' Libera el programa
Call SendMessage(HWNDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) 'Cierra el programa
HWNDParent = 0
End If
End Sub
Private Sub Form_Load()
Picture1.ScaleMode = 3 'pixels <-importante para mover _
y establecer correctamente las dimensiones de la ventana _
de chrome dentro del picture
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End Sub
El handle (hwnd) o 'asa' es un número aleatorio que Windows asigna a cada ventana que se abre en el escritorio. Se pueden cambiar características o enviar mensajes a dichas ventanas usando ese número. Como se ha podido ver con SetWindowPos, SetParent, SendMessage y ShowWindow.
@okik, quería consultarte algo.
Por qué es que en mi PC funciona normal cuando genero el .exe, pero cuando intento abrir el ejecutable en otra PC, sólo se abre Chrome mas no lo incrusta en el picture del form.
Supuse que quizá el problema esté en esta parte
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
Call SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
Quizá el problema esté en no poder obtener el handle padre o no poder meter la aplicación al picture.
Reitero que en mi PC funciona perfecto, pero cuando pruebo el .exe generado en otra PC no logra incrustar Chrome al picture.
Cómo podría solucionarlo?...
Gracias.
Cita de: NsTeam en 8 Febrero 2015, 16:24 PM
@okik, quería consultarte algo.
Por qué es que en mi PC funciona normal cuando genero el .exe, pero cuando intento abrir el ejecutable en otra PC, sólo se abre Chrome mas no lo incrusta en el picture del form.
Supuse que quizá el problema esté en esta parte
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
Call SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
Quizá el problema esté en no poder obtener el handle padre o no poder meter la aplicación al picture.
Reitero que en mi PC funciona perfecto, pero cuando pruebo el .exe generado en otra PC no logra incrustar Chrome al picture.
Cómo podría solucionarlo?...
Gracias.
Hola @NsTeam,
Lo he probado en un portátil LG con Vista y en un PC con XP y funciona en los dos. Sinceramente no se que puede ser. Si no lo mete se me ocurren dos casos. Uno es, que como tu dices pudiera ser que no encuentra el
Handle (hwnd) de Chrome. Es decir el número que hace a referéncia a la ventana abierta de Chrome. Si ocurre esto, puede ser porque el nombre de clase (Chrome_WidgetWin_1) sea distinto por ser una versión más antigua o algo así, o bien porque dicho PC es lento y al Chrome no le da tiempo a abrirse antes de que que tu programa trate de obtener el handle de la ventana de Chrome. Piensa que no se puede obtener el handle hasta que no se haya cargado el programa por completo.
Para solucionar estos posibles problemas haremos lo siguiente:
- Determinar el nombre de clase de Chrome.VB6 y posteriores versiones disponen de una herramienta externa llamada Spy++. Si lo has instalado, vas al menú "Programas/Microsoft Visual Studio 6.0/Herramientas de Microsoft Visual Studio 6.0/" y aquí encontrarás el acceso directo. El nombre del EXE es SPYXX.EXE.
Ahora abre una ventana de Chrome, no hace falta que sea desde tu programa. Ejecuta el Spy++ y una vez abierto pulsa CTRL+F. Se abrirá un formulario y dentro hay un icono con una diana. La diana es arrastrable. Pulsa en ella y arrastrala hasta una ventana abierta de Chrome. Spy++ te irá mostrando los nombre de clase a medida que vayas arrastrando la
diana por la ventana de Chrome y se mostrará un cuadro en negrita hayá por donde arrastres que indica el objeto seleccionado. Tiene varios nombres de clase, el que te interesa el que hace referéncia a la ventana más externa de Chrome. Es posible hacer tu propio Spy++ de forma sencilla mediante GetCursorPos , WindowFromPointXY y GetClassName. Más adelante en este post pondré el código.
- Esperar a que Chrome se cargue antes de obtener el HandleComo parece ser que lo de
Espara(5) (esperar 5 segundos) es ineficiente. Vamos a hacer que el programa no trate de obtener el handle hasta que Chrome no se haya abierto del todo. Para ello hacemos un bucle con Do/Loop que se repetirá indefinidamente hasta que el handle tenga un valor distinto de 0:
Sustituye el código en el lugar que nos ocupa por el siguiente:
HWNDParent = 0
ShellExecute Me.hwnd, "", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (1) 'Espera un segundo antes de intantar obtener el handle
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
LoopComo ves sigo poniendo el
Espera(1), porque si no lo hago, obtiene el handle y carga el chrome pero lo hace tan rápido que no le da tiempo a graficarse y solo muestra un pestaña de color negro.
Luego el código queda así:
Private Sub Command1_Click()
HWNDParent = 0
ShellExecute Me.hwnd, "", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (1) 'Espera un segundo antes de intantar obtener el handle
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
Loop
Call SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End SubEspero que esto sirva para solucionar el problema. ;D
Lo prometido es deuda, así que aquí te dejo un código que te permitira obtener los nombres de clase y otros datos de cualquier ventana que haya abierta en tu escritorio de Windows con tan sólo pasar el puntero del ratón.
- Crea en un form un cuadro de texto
TextBox- Cambia la propiedad del TextBox a Multiline=true (es de solo lectura así que se debe hacer desde la ventana de propiedades)
- Crea un control
TimerPrivate Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" _
(ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" _
(ByVal hModule As Long, _
ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Declare Function GetWindowWord Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Const GWW_HINSTANCE = (-6)
Const GWW_ID = (-12)
Const GWL_STYLE = (-16)
Dim DATOS As String
Private Sub Form_Load()
Text1.Text = ""
Timer1.Interval = 1
Timer1.Enabled = True
End Sub
Sub Timer1_Timer()
Dim pt32 As POINTAPI
Dim ptx As Long
Dim pty As Long
Dim sWindowText As String * 100
Dim sClassName As String * 100
Dim hWndOver As Long
Dim hWndParent As Long
Dim sParentClassName As String * 100
Dim wID As Long
Dim lWindowStyle As Long
Dim hInstance As Long
Dim sParentWindowText As String * 100
Dim sModuleFileName As String * 100
Static hWndLast As Long
Call GetCursorPos(pt32) ' obtiene la posición del cursor
ptx = pt32.x
pty = pt32.y
hWndOver = WindowFromPointXY(ptx, pty) ' Obtiene el handle debajo del cursor
If hWndOver <> hWndLast Then
hWndLast = hWndOver
DATOS = ""
' Muestra el handle de la ventana
DATOS = DATOS & "Window Handle: &H" & Hex(hWndOver) & vbCrLf
r = GetWindowText(hWndOver, sWindowText, 100) ' Window text
DATOS = DATOS & "Window Text: " & Left(sWindowText, r) & vbCrLf
r = GetClassName(hWndOver, sClassName, 100) ' Window Class
DATOS = DATOS & "Window Class Name: " & Left(sClassName, r) & vbCrLf
lWindowStyle = GetWindowLong(hWndOver, GWL_STYLE) ' Window Style
DATOS = DATOS & "Window Style: &H" & Hex(lWindowStyle) & vbCrLf
hWndParent = GetParent(hWndOver) ' Consigue el handle padre de una ventana
'Obtiene más información si hay un handle padre
If hWndParent <> 0 Then
wID = GetWindowWord(hWndOver, GWW_ID) ' Obiene el ID
DATOS = DATOS & "Window ID Number: &H" & Hex(wID) & vbCrLf
DATOS = DATOS & "Parent Window Handle: &H" & Hex(hWndParent) & vbCrLf
'Obiene el texto de la ventana
r = GetWindowText(hWndParent, sParentWindowText, 100)
DATOS = DATOS & "Parent Window Text: " & Left(sParentWindowText, r) & vbCrLf
'Consigue el ClassName de la ventana padre
r = GetClassName(hWndParent, sParentClassName, 100)
DATOS = DATOS & "Parent Window Class Name: " & Left(sParentClassName, r) & vbCrLf
Else
'Obtiene los campos cuando no es padre:
DATOS = DATOS & "Window ID Number: N/A" & vbCrLf
DATOS = DATOS & "Parent Window Handle: N/A" & vbCrLf
DATOS = DATOS & "Parent Window Text : N/A" & vbCrLf
DATOS = DATOS & "Parent Window Class Name: N/A" & vbCrLf
End If
' Consigue el window instance:
hInstance = GetWindowWord(hWndOver, GWW_HINSTANCE)
'Consigue el modulo de nombre de archivo (obsoleto)
r = GetModuleFileName(hInstance, sModuleFileName, 100)
DATOS = DATOS & "Module: " & Left(sModuleFileName, r)
End If
Text1.Text = DATOS
End Sub
Saludos
Lo he probado, pero aún así no logro abrir el ejecutable en mi laptop, lo probé en otra PC, y en la PC sí lo abre.
Lo curioso es que en mi laptop el 50% abre chrome y lo incrusta al picture, y el otro 50% sólo abre chrome pero no lo incrusta y efectivamente también el nombre de la clase es "Chrome_WidgetWin_1", lo cual no creo que sea el error
De todas maneras gracias.
Cita de: okik en 9 Febrero 2015, 17:50 PM
Que curioso...
A mi me pasaba lo mismo pero con el otro programa de inglés que te comenté, el que he incrustado en un form porque se muestra a pantalla completa y me oculta la barra de tareas. Es antiguo y de 16bits. Cuando se inicia sale un video y hay que hacer clic para iniciar el programa. El problema resultó ser porque incrustaba desde Form_Load. Parace ser que todo se tiene que hacer en un orden: Cargar form, cargar el otro programa, incrustar. Cuando se intenta hacer todo de golpe o no se le da el tiempo suficiente que se necesite para cualquiera de los tres pasos, se produce un fallo. He solucionado el problema haciendo que espere un segundo antes de ejecutar el código, a que le de tiempo a cargarse el form, antes de ejecutar el otro programa. Pero yo creo que el caso es distinto por que a ti el Chrome se te carga y no produce error. Siemplemente no se introduce en el Picture.
Prueba a hacer lo siguiente. Del mismo modo que nos hemos asegurado que obtenemos el handle de Chrome con el Do/Loop, hacemos otro Do/Loop para asegurarnos que Chrome se ha introducido en el Picture:
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
Si Chrome no se ha introducido en el Picture, N& tiene valor 0. Entonces vuelve a reintentar el proceso hasta que N& sea distinto de 0, es decir, que se haya introducido Chrome en el form.
Y dado que hay un bucle Loop y DoEvents es recomendable añadir en al Form_Unload el evento END.
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End
End Sub
Esto es porque si el valor de N& fuera siempre 0 por no poder cargar Chrome, luego no podrías cerrar el form.
Dado que Do/Loop es un bucle que no termina nunca yo pondría, en cualqueira de los bucles un contador para que cuando por ejemplo llegase a X intentos, se parara el proceso y mostrara un mensaje informando de lo sucedido y saliera del bucle. En este caso ya no necesitarías poner END en Form_Unload.
Por cierto, si esto último no sirviera y a pesar de ello solucionas el problema, cuentame como lo has hecho o porqué te pasaba eso. No me dejes en ascuas.
Saludos
Hola, acabo de probarlo y aún así. Te explico lo que sucede.
Tengo Chrome abierto, está en pantalla completa pero minimizado, y al iniciar el proyecto.exe y por primera vez le doy click al "command_button", sólo abre la página en una nueva pestaña de Chrome y me muestra Chrome pero no lo incrusta al picture.
Cuando le doy nuevamente click al "Command_button", abre la página en otra nueva pestaña , me muestra chrome y recién la incrusta al picture.
Y después ya normal, cada vez que le doy click, abre Chrome y lo incrusta al picture y así sucesivamente.
(incluso probé el parameto de Chrome para que lo abra en una nueva ventana --new-window, pero nada, ese no era el problema)
Aquí te dejo el video de lo que te explico.
[youtube=640,360]https://www.youtube.com/watch?v=i1MEd0T7JzA[/youtube]
Lo que creo es que quizá en el FormLoad el código no carga bien ya que solamente al comienzo es que no lo incrusta al picture, pero después sí.
---------------------------------------------------------------------
Cita de: okik en 10 Febrero 2015, 16:08 PM
Que curioso...
A mi me pasaba lo mismo pero con el otro programa de inglés que te comenté, el que he incrustado en un form porque se muestra a pantalla completa y me oculta la barra de tareas. Es antiguo y de 16bits. Cuando se inicia sale un video y hay que hacer clic para iniciar el programa. El problema resultó ser porque incrustaba desde Form_Load. Parace ser que todo se tiene que hacer en un orden: Cargar form, cargar el otro programa, incrustar. Cuando se intenta hacer todo de golpe o no se le da el tiempo suficiente que se necesite para cualquiera de los tres pasos, se produce un fallo. He solucionado el problema haciendo que espere un segundo antes de ejecutar el código, a que le de tiempo a cargarse el form, antes de ejecutar el otro programa. Pero yo creo que el caso es distinto por que a ti el Chrome se te carga y no produce error. Siemplemente no se introduce en el Picture.
Prueba a hacer lo siguiente. Del mismo modo que nos hemos asegurado que obtenemos el handle de Chrome con el Do/Loop, hacemos otro Do/Loop para asegurarnos que Chrome se ha introducido en el Picture:
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
Si Chrome no se ha introducido en el Picture, N& tiene valor 0. Entonces vuelve a reintentar el proceso hasta que N& sea distinto de 0, es decir, que se haya introducido Chrome en el form.
Y dado que hay un bucle Loop y DoEvents es recomendable añadir en al Form_Unload el evento END.
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End
End Sub
Esto es porque si el valor de N& fuera siempre 0 por no poder cargar Chrome, luego no podrías cerrar el form.
Dado que Do/Loop es un bucle que no termina nunca yo pondría, en cualqueira de los bucles un contador para que cuando por ejemplo llegase a X intentos, se parara el proceso y mostrara un mensaje informando de lo sucedido y saliera del bucle. En este caso ya no necesitarías poner END en Form_Unload.
Por cierto, si esto último no sirviera y a pesar de ello solucionas el problema, cuentame como lo has hecho o porqué te pasaba eso. No me dejes en ascuas.
Saludos
Cita de: NsTeam en 11 Febrero 2015, 00:08 AM
Hola, acabo de probarlo y aún así. Te explico lo que sucede.
Tengo Chrome abierto, está en pantalla completa pero minimizado, y al iniciar el proyecto.exe y por primera vez le doy click al "command_button", sólo abre la página en una nueva pestaña de Chrome y me muestra Chrome pero no lo incrusta al picture.
Cuando le doy nuevamente click al "Command_button", abre la página en otra nueva pestaña , me muestra chrome y recién la incrusta al picture.
Y después ya normal, cada vez que le doy click, abre Chrome y lo incrusta al picture y así sucesivamente.
(incluso probé el parameto de Chrome para que lo abra en una nueva ventana --new-window, pero nada, ese no era el problema)
Aquí te dejo el video de lo que te explico.
[youtube=640,360]https://www.youtube.com/watch?v=i1MEd0T7JzA[/youtube]
Lo que creo es que quizá en el FormLoad el código no carga bien ya que solamente al comienzo es que no lo incrusta al picture, pero después sí.
---------------------------------------------------------------------
---------------------------------------------------------------------
Pues te juro que a mi no me pasa eso. He abierto Chrome, he ejecutado el programa ya compilado, fuera del entorno de programación. Le he dado al botón y se a incrustado con una nueva pestaña.
[youtube=640,360]https://www.youtube.com/watch?v=XybXuUiHghI&feature=youtu.be[/youtube]
Cuando tengo problemas, lo que hago es crear puntos de interrupción. Lo único que has de hacer es Clic en la barrita vertical que hay en el lado izquierdo del código de vb6. Se pondrá un punto rojo. Luego le das a F5 (Iniciar). Entonces el programa se inicia y para el proceso en ese punto. Luego colocas el puntero sobre una variable del código y aparece una etiqueta que te indica el valor.
(http://hojadecalculo.umh.es/vba/Apuntes.Amp_archivos/image079.jpg)
Puedes hacer un punto de interrupción debajo de:
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
LoopNo se pueden hacer puntos de interrupción en líneas vacias así que lo haces en la siguiente línea. Luego pones el puntero sobre HWNDParent, la primera vez que ejecutes la aplicación, y si pone 0 es que no ha obtenido el HWNDParent.
Si no haces estas cosas vas un poco a ciegas. Porque no sabes lo que está ocurriendo en cada momento. Creo que es la única manera de encontrar una solución al problema.
No se si el tener el Windows7 pudiera tener algo que ver. Pero quien sabe.
El código lo voy a poner otra vez tal y como a mí me ha quedado al final. Porque entre tanta correción y tal pues es un poco lío.
'Nombres de clase (ClassName) de Chrome
'Chrome_WidgetWin_1 <---Padre
'Chrome_RenderWidgetHostHWND <---hijo
'//Funciones API para incrustar la aplicación en el picture
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal HWNDParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
'//Funcion API para obtener el handle de la aplicación que se quiere menter en el Picture
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'//Función para cerrar la aplicación incrustada
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const SHOW_FULLSCREEN = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3
Const SWP_NOZORDER = &H4
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&
'//////////////////////////////////////////////
'//'Variable para el handle padre de Chrome //
'//Debe ser variable pública para que al //
'//cerrar el form únicamente se cierre el //
'//chrome incrustado en el picture y no //
'//otra ventana externa de chrome /////
Dim HWNDParent As Long
'//////////////////////////////////////////////
Private Sub Command1_Click()
HWNDParent = 0
ShellExecute Me.hwnd, "", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (1) 'Espera 1 segundo a que se cargue
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
Loop
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub
Private Sub Espera(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Private Sub Cerrar_Chrome(hwnd As Long)
If HWNDParent <> 0 Then
Call SetParent(HWNDParent, 0) ' Libera el programa
Call SendMessage(HWNDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) 'Cierra el programa
HWNDParent = 0
End If
End Sub
Private Sub Form_Load()
Picture1.ScaleMode = 3 'pixels <-importante para mover _
y establecer correctamente las dimensiones de la ventana _
de chrome dentro del picture
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End
End Sub
Hola, creo que ya di con el error, pero no estoy seguro. De todas formas hice lo que me dijiste y esto es lo que me mostró:
(http://gamerzfox.com/123.jpg)
El programa en sí creo que sí obtiene el HWNDParent, ya que cuando lo pruebo directamente desde el Iniciar (F5), me funciona a la perfección.
Di con algo interesante:
Cuando ejecuto el proyecto.exe(compilado) y lo abro, sucede el problema; pero,
Si ejecuto el proyecto.exe(compilado) (pero tengo el Vb6 abierto, sin necesidad de que tenga código alguno) me funciona a la perfección
(http://gamerzfox.com/123a.jpg)
Lo he probado más de 10 veces y efectivamente cuando vb6 está abierto, me funciona a la perfección.
Aquí te dejo un video de lo que me sucede, y no sólo sucede en mi PC y mi laptop, también en todas las PC que lo probé
[youtube=640,360]https://www.youtube.com/watch?v=zXTfUBzm6yQ[/youtube]
Otra cosa del cuál me he dado cuenta es que cuando el VB6 está abierto, la barra de tareas se cambia de color y me aparece el mensaje de:
(http://gamerzfox.com/123b.jpg)
Y cuando no tengo el VB6 abierto, la barra de tareas cambia a su normalidad.
(http://gamerzfox.com/123c.jpg)
Aunque no creo que esto tenga nada que ver.
Cita de: okik en 11 Febrero 2015, 16:43 PM
VB6 ya que da un poco viejo para Windows7. Además tu Windows es de 64 bits y VB6 es de 32. Tu Chrome también debe ser una versión de 64bits.
Creo que cosas así te van a ocurrir constantemente si mezclas ambas cosas VB6 y W7 64bits.
Lo que voy ha hacer, por mera curiosidad, es instalarme en VirtualBox el Windows7 64bits y probar el programa, a ver que pasa.
Mientras, se me ocurre que ejecutes el programa con "Compatibilidad con win 98 o XP" y a ver que pasa. No se me ocurre otra cosa.
Pudiera ser que cuando se ejecuta VB6 se activa algún servicio de compatibilidad y cuando se cierra VB6 se desactiva. Pero solo son suposiciones mías.
No se si tienes VB.NET, pero si no lo usas y vas a crear programas para W7 64bits ya pudieras ir pensando en cambiar a VB.Net. Yo he usado VB6 durante más de 10 años, como aficionado, pero ahora he empezado con VB.Net2010. Al principio cuesta un poco, por que ha cambiado mucho, pero poco a poco vas aprendiendo. De echo el programa para incrustar el curso de ingles que te comenté lo hice con VB.Net2010.
Probaré el programa en las dos versiones, a ver que pasa...
Cita de: okik en 12 Febrero 2015, 17:25 PM
VB6 ya que da un poco viejo para Windows7. Además tu Windows es de 64 bits y VB6 es de 32. Tu Chrome también debe ser una versión de 64bits.
Creo que cosas así te van a ocurrir constantemente si mezclas ambas cosas VB6 y W7 64bits.
Lo que voy ha hacer, por mera curiosidad, es instalarme en VirtualBox el Windows7 64bits y probar el programa, a ver que pasa.
Mientras, se me ocurre que ejecutes el programa con "Compatibilidad con win 98 o XP" y a ver que pasa. No se me ocurre otra cosa.
Pudiera ser que cuando se ejecuta VB6 se activa algún servicio de compatibilidad y cuando se cierra VB6 se desactiva. Pero solo son suposiciones mías.
No se si tienes VB.NET, pero si no lo usas y vas a crear programas para W7 64bits ya pudieras ir pensando en cambiar a VB.Net. Yo he usado VB6 durante más de 10 años, como aficionado, pero ahora he empezado con VB.Net2010. Al principio cuesta un poco, por que ha cambiado mucho, pero poco a poco vas aprendiendo. De echo el programa para incrustar el curso de ingles que te comenté lo hice con VB.Net2010.
Probaré el programa en las dos versiones, a ver que pasa...
Gracias por tu respuesta, probé con conpatibilidad de win98 y Win XP, pero aún así, sigue surgiendo el mismo problema y no tengo instalado VB.NET sólo Vb6.
Espero puedas decirme qué tal te fue cuando instalaste el W7 64 bits.
Saludos!
Bueno compañero, aquí estoy de nuevo. He ejecutado el programa bajo las siguientes condiciones:
- Máquina: VirtualBox
- SO: Windows 7 Enterprise SP1 64 bits
- Chrome: Google Chrome Versión 40.0.2214.111 m (última)
Y estamos donde estábamos, porque a mi me sigue funcionando perfectamente salvo un excepción: Chrome se incrusta mostrando una pestaña de color negro. Para solucionarlo he añadido ShowWindow en el código para refrescar la ventanan de Chrome con SW_RESTORE.También ocurre que tarda un poco en mostrarse, pero también es verdad que W7 me va algo lento en el VirtualBox. Supongo que será por eso.
Esperaba que me pasara lo mismo que a ti y luego intentar solucionar el problema pero no ha sido así.
Para corregir el problema de visualización, como he dicho antes he añadido "ShowWindow HWNDParent, SW_RESTORE"(línea 18))
Const SW_RESTORE = 9
Private Sub Command1_Click()
HWNDParent = 0
ShellExecute Me.hwnd, "", "chrome.exe", _
"http://www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (1) 'Espera un segundo a que se cargue Chrome
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
Loop
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
'Refresca Chrome por si no se visualiza correctamente
ShowWindow HWNDParent, SW_RESTORE
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub
A ver si lo averiguas o alguien sabe algo y te contesta de porqué este fallo. Incluso que haya otra forma de hacerlo. ¿Por qué no pruebas con Firefox? Yo ya no puedo aportar nada más.
Por cierto, si no quieres que se cree una pestaña nueva sustituye "http://www.elhacker.net" por vbNullString en ShellExecute. Yo lo puse como demostración, pero si no quieres ponerlo pues no hace falta.
Hola, lo probé y aún así persiste el problema, lo curioso es que cuando al proyecto.exe le doy a compatibilidad - configuracion - ejecutar con 256 colores, ahí sí , se soluciona el problema.
Otra cosa que me di cuenta es que sólo pasa con mi PC y mi laptop que tienen Windows 7 'registrado', cuando lo probé en otra PC que tiene W7 pero no lo tiene registrado, entonces lo abre normal.
En mi PC y mi Laptop, el borde del navegador Chrome, es color negro
En la otra PC, el borde del navegador es Azul,
Estoy seguro que en el virtualbox que tienes, cuando abres Chrome, el borde es de color azul (como en la PC que lo probe que no tiene W7 registrado), en cambio en mi PC y mi laptop el borde es de color negro.
Quería consultarte algo que mencionaste al final, lo de sustituir "http://www.elhacker.net" por vbNullString, lo hice y efectivamente me abre chrome en una nueva ventana, pero ¿Cómo hago para que en esa nueva ventana abra http://elhacker.net?
Cita de: okik en 13 Febrero 2015, 18:35 PM
Bueno compañero, aquí estoy de nuevo. He ejecutado el programa bajo las siguientes condiciones:
- Máquina: VirtualBox
- SO: Windows 7 Enterprise SP1 64 bits
- Chrome: Google Chrome Versión 40.0.2214.111 m (última)
Y estamos donde estábamos, porque a mi me sigue funcionando perfectamente salvo un excepción: Chrome se incrusta mostrando una pestaña de color negro. Para solucionarlo he añadido ShowWindow en el código para refrescar la ventanan de Chrome con SW_RESTORE.También ocurre que tarda un poco en mostrarse, pero también es verdad que W7 me va algo lento en el VirtualBox. Supongo que será por eso.
Esperaba que me pasara lo mismo que a ti y luego intentar solucionar el problema pero no ha sido así.
Para corregir el problema de visualización, como he dicho antes he añadido "ShowWindow HWNDParent, SW_RESTORE"(línea 18))
Const SW_RESTORE = 9
Private Sub Command1_Click()
HWNDParent = 0
ShellExecute Me.hwnd, "", "chrome.exe", _
"http://www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
Espera (1) 'Espera un segundo a que se cargue Chrome
Do While HWNDParent = 0
HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
DoEvents
Loop
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
'Refresca Chrome por si no se visualiza correctamente
ShowWindow HWNDParent, SW_RESTORE
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub
A ver si lo averiguas o alguien sabe algo y te contesta de porqué este fallo. Incluso que haya otra forma de hacerlo. ¿Por qué no pruebas con Firefox? Yo ya no puedo aportar nada más.
Por cierto, si no quieres que se cree una pestaña nueva sustituye "http://www.elhacker.net" por vbNullString en ShellExecute. Yo lo puse como demostración, pero si no quieres ponerlo pues no hace falta.
Es increible que con la de gente que ha entrado a ver este post sobre tu pregunta, nadie haya encontrado la razón de tu problema desde que lo planteaste.
Pues resulta que el problema es la composición del escritorio. Yo en el portatil tengo Vista sin la composición de escritorio y transparencia porque usa mucha memoria y el rendimiento es menor. Y en Windows 7 como lo instalé en VirtualBox no se puede habilitar la composición de escritorio ni las transparencias.
La composición de escritorio es lo que permite crear efectos de brillo de las ventanas y las trasparencias. Esto es en Vista y Windows7 si lo tienes con la mejor apariencia. Prueba a cambiar el tema del escritorio a windows clásico o quitar las transparéncias. Seguro que si haces eso no tienes problemas.
Ayer caí en la cuenta que si Chrome se ve transperente o con efecto de brillo por la composición de escritorio ¿que pasará cuando lo meta en el Picture en una aplicación creada con VB6?. Cuando lo incrusto en el Picture se pone negro, como tu decías. Además, no se incrusta en el Picture cuando ya se ha abierto previamente también como tu decías, pero sí la segunda vez. Así que el problema es por tener habilitada la composición de escritorio. Ocurre lo mismo con VB.net.
Por alguna razón que no entiendo, aunque encuentra el Handle no lo incrusta. Así que he recurrido a un código más pesado. He creado un Módulo con el siguiente código:
Código para un Módulo
Option Explicit
'Constantes
'-----------------------------------
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = _
(TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or _
TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Declare Function GetPriorityClass Lib "kernel32" _
(ByVal hProcess As Long) As Long
'Estructura para los procesos
'-----------------------------------
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long ' Flags 'Reservado; no usar.
szExeFile As String * MAX_PATH
End Type
'Funciones Api para listar los procesos
'--------------------------------------------------------
Private Declare Function CreateToolhelp32Snapshot Lib _
"kernel32" _
(ByVal lFlags As Long, _
ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function _
Process32Next Lib "kernel32" _
(ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Public Const GW_HWNDNEXT = 2
Public Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwprocessid As Long) As Long
Public Function ProcIDFromWnd(ByVal hwnd As Long) As Long
Dim idProc As Long
GetWindowThreadProcessId hwnd, idProc
ProcIDFromWnd = idProc
End Function
Public Function GetWinHandle(hInstance As Long) As Long
Dim tempHwnd As Long
tempHwnd = FindWindow(vbNullString, vbNullString)
Do Until tempHwnd = 0
If GetParent(tempHwnd) = 0 Then
If hInstance = ProcIDFromWnd(tempHwnd) Then
GetWinHandle = tempHwnd
Exit Do
End If
End If
tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
Loop
End Function
Public Function BuscarHandleChrome() As Long
Dim F As Long, r As Long, x As Long
Dim sWindowText As String * 255 'Variable para introducir el texto de una barra con espacios
Dim sClassName As String * 255
Dim hSnapShot As Long
Dim Name As String * 255
Dim uProcess As PROCESSENTRY32
Dim elemento As ListBox
Dim sTextoBarra As String
Dim sNombreClase As String
Dim shwnd As Long
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r > 0
r = Process32Next(hSnapShot, uProcess)
shwnd = GetWinHandle(uProcess.th32ProcessID)
x = GetClassName(shwnd, sClassName, 255)
sNombreClase = Left(sClassName, x) '<<----Nombre de Clase
If Trim(sNombreClase) <> "" Then
If IsWindow(shwnd) = 1 Then 'si es una aplicación visible
If IsWindow(shwnd) Then
If sNombreClase = "Chrome_WidgetWin_1" Then BuscarHandleChrome = shwnd
End If
End If
End If
Loop
End Function
Lo que hace es listar las aplicaciones que se están ejecutando y si encuentra una con el nombre de clase "Chrome_WidgetWin_1" entonces introduce el handle en la variable HWNDParent.
Para el Form el siguiente código:
- Añadir un Picture
- Añadir un Botón
- Añadir un control Timer
Option Explicit
'Nombres de clase (ClassName) de Chrome
'Chrome_WidgetWin_1 <---Padre
'Chrome_RenderWidgetHostHWND <---hijo
'//Funciones API para incrustar la aplicación en el picture
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal HWNDParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'//Función para cerrar la aplicación incrustada
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const SW_SHOWNORMAL = 1
Const SW_RESTORE = 9
Const SWP_NOZORDER = &H4
Const HWND_TOP = 0
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&
' Función api SetWindowTheme
Private Declare Function SetWindowTheme Lib "UxTheme.dll" ( _
ByVal hwnd As Long, _
ByVal pszSubAppName As Long, _
ByVal pszSubIdList As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
'//////////////////////////////////////////////
'//'Variable para el handle padre de Chrome //
'//Debe ser variable pública para que al //
'//cerrar el form únicamente se cierre el //
'//chrome incrustado en el picture y no //
'//otra ventana externa de chrome /////
Dim HWNDParent As Long
'//////////////////////////////////////////////
Dim N&
Private Sub Command1_Click()
If N& = 0 Then ' Si no hay nada dentro del Picture ejecuta el código
'ShellExecute Me.hWnd, "open", "chrome.exe", _
"www.elhacker.net", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWNORMAL
Shell Environ("programfiles") & "\Google\Chrome\Application\" & "chrome.exe", vbNormalFocus
Do While HWNDParent = 0
HWNDParent = BuscarHandleChrome
DoEvents
Loop
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apclicación en el picture
DoEvents
Loop
'Refresca Chrome por si no se visualiza correctamente
ShowWindow HWNDParent, SW_RESTORE
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End If
End Sub
Private Sub Cerrar_Chrome(hwnd As Long)
If HWNDParent <> 0 Then
Call SetParent(HWNDParent, 0) ' Libera el programa
Call SendMessage(HWNDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) 'Cierra el programa
HWNDParent = 0
End If
End Sub
Private Sub Form_Load()
Picture1.ScaleMode = 3 'pixels <-importante para mover _
y establecer correctamente las dimensiones de la ventana _
de chrome dentro del picture
Timer1.Interval = 1
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cerrar_Chrome(HWNDParent) 'Cierra Chrome
End
End Sub
Private Sub Timer1_Timer()
Dim x
x = IsWindow(HWNDParent)
If x = 0 Then
N& = 0
HWNDParent = 0
End If
End Sub
Ahora no falla. El problema que surge ahora es que se ve mal cuando está activada la composición de escritorio. Eso si que ya no tengo ni idea de como arreglarlo.
He probado usando SetWindowTheme para cambiar el estilo de la ventana de Chrome a Windows Clásico. Pero ni por esas, porque aunque sí lo convierte a Windows clásico, continúa estando habilitada la composición de escritorio en la ventana de Chrome. Por eso se ve negro. Creo que la única manera de que se vea bien es utilizando algún código, si existe, que quite la composición del escritorio sólo en la ventana incrustada.
Si te fijas he anulado ShellExecute porque da problemas. Compruebalo tu mismo.
si quieres que abra en un determinada página con shell, basta con añadir la página después de "Chrome.exe" separado por un espacio.
Ejemplo:
Shell Environ("programfiles") & "\Google\Chrome\Application\" & _
"chrome.exe www.google.co.uk", vbNormalFocus
También:
Shell Environ("programfiles") & "\Google\Chrome\Application\" & _
"chrome.exe " & "www.google.co.uk", vbNormalFocus
Esta aplicación en principio no sirve para nada, se trata de un ejemplo y luego cada cual lo use, lo arregle, lo modifique y lo mejore como le de la gana si le sirve. A mí me ha servido para viejas apliaciones de 16bits que se me ejecutaban a patanalla completa: cursos de inglés y enciclopedias. Que aunque son viejas apliaciones contienen información muy útil y las sigo usando de vez en cuando. Según lo que sea habrá que cambiar alguna cosa que otra del código. Las correcciones están pensadas para Chrome pero otras aplicaciones no dan los mismos problemas.
Pues así lo dejo para quien le sirva...