Ejemplos usando el Api de windows para Visual basic

152 - Incrustar un programa en un picturebox o Form

Volver al Listado Api - Anterior - Siguiente

Ejemplo que incrusta la calculadora de windows en un control PictureBox, utilizando el Api SetParent entre otras funciones

vista de la calculadora de windows incrustada en el control picturebox

El ejemplo yo lo hice para meter la calculadora de windows en un Picturebox, pero se puede utilizar para otros programas, aunque no lo chequé muy bien

Para hacer esto se utiliza el Api SetParent. Pero el ejemplo utiliza varias otras funciones, por ejemplo para remover los menús de la calculadora "Edición, ver, ayuda" ( Api DeleteMenu ). También, el Api GetClientRect para recuperar las dimensiones del área cliente de la ventana, ya que luego de incrustarla, se redimensiona el picturebox al tamaño del área cliente de la misma, y para hacer el redimensionado es necesario obtener dichas dimensiones ( alto, ancho ) . También para remover la barra de título de la ventana con las Apis GetWindowLong, SetWindowLong y SetWindowPos

El ejemplo necesita un control Picturebox, y dos CommandButton, Command1 y Command2

Código fuente en el formulario

Option Explicit 'Incrusta Private Sub Command1_Click() Call Incrustar_calculadora("calc.exe", Picture1, "Calculadora", Me) End Sub 'Libera y cierra Private Sub Command2_Click() Call Liberar_Programa(El_Hwnd_Programa) End Sub Private Sub Form_Load() Me.Caption = " Ejemplo del Api SetParent para" & _ "incrustar la calculadora en un picturebox" Command1.Caption = " >> Incrustar calculadora " Command2.Caption = " Liberar y finalizar " End Sub 'Libera y cierra Private Sub Form_Unload(Cancel As Integer) Call Cerrar_Programa(El_Hwnd_Programa) End End Sub

Código fuente en un módulo bas:

Option Explicit '------------------------------------------------------------- ' Declaraciones Api '------------------------------------------------------------- 'Recupera el Hwnd de un menú Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long 'Elimina el menú de una aplicación Private Declare Function DeleteMenu Lib "user32.dll" ( _ ByVal hMenu As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long) As Long 'Recupera la cantidad de Item de menúes para saber cuantos hay que eliminar Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long 'Redibuja - repinta la barra de menú luego de eliminarlo Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 'Para cerrar-finalizar una apicación abierta por medio de su HWND 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 'Api: busca el Handle del programa Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long ' función Api SetParent Private Declare Function SetParent Lib "user32" ( _ ByVal hWndChild As Long, _ ByVal hWndParent As Long) As Long ' Declaración de la función Api ShowWindow Private Declare Function ShowWindow Lib "user32" ( _ ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long 'Esta función recupera el ancho y alto del área _ cliente de la ventana en pixeles Private Declare Function GetClientRect Lib "user32" ( _ ByVal hwnd As Long, _ lpRect As RECT) As Long ' Estas tres funciones es para eliminar la barra de título _ del programa que se va a incrustar Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong 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 '------------------------------------------------------------- ' Constantes '------------------------------------------------------------- 'Constante para ShowWindow - para maximizar la ventana Const SHOWMAXIMIZED_eSW = 3& 'Constante para usar con el Api DeleteMenu Const MF_BYPOSITION = &H400& Const MF_REMOVE = &H1000& 'Constante para usar con el Api SendMessage para cerrar _ la aplicación ( en este caso La calculadora ) Const SC_CLOSE = &HF060& Const WM_SYSCOMMAND = &H112 'Constante para usar con GetWindowLong y SetWindowLong Private Const GWL_STYLE = (-16) Private Const WS_CAPTION = &HC00000 'Constantes para SetWindowPos Private Const SWP_FRAMECHANGED = &H20 Private Const SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const SWP_NOZORDER = &H4 'Para usar con el Api GetClientRect Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type '------------------------------------------------------------- ' Variables '------------------------------------------------------------- Dim APP_Rect As RECT ' Mantiene el Handle del programa Public El_Hwnd_Programa As Long '------------------------------------------------------------- ' Pocedimientos y funciones '------------------------------------------------------------- 'Elimina y reestablece la barra de título de una ventana 'El primer parámetro es el Hwnd de la misma Sub Quitar_Barra_Titulo(ByVal El_Hwnd_Programa As Long, _ ByVal Quitar As Boolean) Dim El_Estilo As Long 'Almacena en la variable el estilo actual El_Estilo = GetWindowLong(El_Hwnd_Programa, GWL_STYLE) If Not Quitar Then El_Estilo = El_Estilo Or WS_CAPTION Else El_Estilo = El_Estilo And Not WS_CAPTION End If 'Aplica el nuevo estilo SetWindowLong El_Hwnd_Programa, GWL_STYLE, El_Estilo SetWindowPos El_Hwnd_Programa, 0, 0, 0, 0, 0, _ SWP_FRAMECHANGED Or _ SWP_NOMOVE Or _ SWP_NOSIZE Or _ SWP_NOZORDER End Sub 'Elimina el menú de una ventana específica Sub Eliminar_Menu(El_Hwnd_Programa As Long) Dim hwnd_Menu As Long Dim n_Menu As Long Dim i As Integer ' Recuper el hwnd del menu del programa hwnd_Menu = GetMenu(El_Hwnd_Programa) If hwnd_Menu Then 'cantidad de menúes n_Menu = GetMenuItemCount(hwnd_Menu) If n_Menu Then 'Recorre todos los menú y los elimina For i = 1 To n_Menu Call DeleteMenu(hwnd_Menu, 0, MF_BYPOSITION Or MF_REMOVE) Next 'Repinta la barra de menú Call DrawMenuBar(El_Hwnd_Programa) End If End If End Sub 'Cierra Sub Cerrar_Programa(El_Hwnd_Programa As Long) 'Cierra el programa abierto, en este caso la calculadora Call SendMessage(El_Hwnd_Programa, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&) End Sub 'mete la ventana en el contenedor Sub Incrustar_calculadora(Path_programa As String, _ Contenedor As Object, _ Titulo_Ventana As String, _ El_Form As Form) Dim OLD_Scale As Integer 'almacena la escala para reestablecerla luego OLD_Scale = El_Form.ScaleMode El_Form.ScaleMode = vbPixels If El_Hwnd_Programa = 0 Then 'Abre el programa Shell Path_programa, vbMinimizedNoFocus DoEvents 'Handle de la aplicación El_Hwnd_Programa = FindWindow(vbNullString, Titulo_Ventana) 'REcupera el ancho y alto del área cliente Call GetClientRect(El_Hwnd_Programa, APP_Rect) 'Redimensiona el picturebox al ancho y alto del programa Contenedor.Width = (APP_Rect.Right - APP_Rect.Left) Contenedor.Height = (APP_Rect.Bottom - APP_Rect.Top) Call ShowWindow(El_Hwnd_Programa, vbHide) 'Elimina la barra de título, los menúes y lo incrusta Call Quitar_Barra_Titulo(El_Hwnd_Programa, True) Call Eliminar_Menu(El_Hwnd_Programa) Call Incrustar(El_Hwnd_Programa, Contenedor) End If El_Form.ScaleMode = OLD_Scale End Sub Private Sub Incrustar(h_Programa As Long, el_Contenedor As Object) Dim Ret As Long 'Lo metemos dentro del Picture1 Call SetParent(h_Programa, el_Contenedor.hwnd) 'Maximizamos la ventana incrustada dentro del contenedor, mediante el _ Api showWindow, pasándole la constante SHOWMAXIMIZED_eSW Ret = ShowWindow(h_Programa, SHOWMAXIMIZED_eSW) End Sub ' Libera la ventana pasándole en el segundo _ parámetro el valor 0 y la cierra Sub Liberar_Programa(el_Hwnd As Long) If el_Hwnd <> 0 Then ' Libera el programa Call SetParent(el_Hwnd, 0) 'Lo cierra Call Cerrar_Programa(El_Hwnd_Programa) El_Hwnd_Programa = 0 End If End Sub

Enlaces relacionados con el Api SetParent

Buscar en Recursos vb