Colabora
 

Incrustar un programa en un form y quitar los menus

 

Fecha: 18/Oct/2007 (18-oct-07)
Autor: Fernando Manchado

 


Introducción

EL título lo dice todo, pero aún así lo explico, necesitaba hacer una aplicacion para una pantalla táctil y me exigían poder contar con un teclado completo pantalla. Se me ocurrió que la mejor solución era aprovechar el de windows. La verdad es que para manejar las apis soy un poco torpe así que busque ayude en internet. Por un lado en este página encontre el dockforms que me hacía pensar en incrustar el teclado de windows, pero tenia una pega, no sabia como deshabilitar los menus, botones, etc... Seguí investigando y encontre en otro sitio algo parecido pero que lo hacia con la calculadora de windows, aunque me faltaba que el programa incrustado se ajustara al tamaño de picture, asi que "mezclé" ejemplos y consegui esto.

 

Un Teclado integrado

El ejemplo es bastante simple, usa un shell para abrir el teclado, captura su identificador lo incrusta dentro de un picture, elimina el Caption y las barras de menus y lo ajusta al tamaño del picture.

No hay mucho mas asi que aqui va el codigo.

El código:

El código del módulo

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
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



' Para posicionar una ventana según su hWnd
Private Declare Function MoveWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

' Para cambiar el tamaño de una ventana y asignar los valores máximos y mínimos del tamaño
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECTAPI
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type WINDOWPLACEMENT
    Length As Long
    Flags As Long
    ShowCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECTAPI
End Type

Private Declare Function GetWindowPlacement Lib "user32" _
    (ByVal hWnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long

'-------------------------------------------------------------
    ' 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
Call SendMessage(El_Hwnd_Programa, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)

End Sub

'mete la ventana en el contenedor

Sub Incrustar_teclado(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)
    

    
    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)
    'para establecer el tamaño del programa a su contenedor
    Call posDockForm(El_Hwnd_Programa, Contenedor, True)
    
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

Private Sub posDockForm(ByVal formhWnd As Long, _
                        ByVal picDock As PictureBox, _
                        Optional ByVal ajustar As Boolean = True)
    ' Posicionar el formulario indicado en las coordenadas del picDock
    ' Si Ajustar es True, se ajustará al tamaño del contenedor,
    ' si Ajustar es False, se quedará con el tamaño actual.
    Dim nWidth As Long, nHeight As Long
    Dim wndPl As WINDOWPLACEMENT
    '
    If ajustar Then
        nWidth = picDock.ScaleWidth \ Screen.TwipsPerPixelX
        nHeight = picDock.ScaleHeight \ Screen.TwipsPerPixelY
    Else
        ' el tamaño del formulario que se va a posicionar
        Call GetWindowPlacement(formhWnd, wndPl)
        With wndPl.rcNormalPosition
            nWidth = .Right - .Left
            nHeight = .Bottom - .Top
        End With
    End If
    Call MoveWindow(formhWnd, 0, 0, nWidth, nHeight, True)
End Sub

 

El código del form

Option Explicit

Private Sub Form_Load()
Call Incrustar_teclado("osk.exe", Picture1, "Teclado en pantalla", Me)

End Sub

Private Sub Form_Resize()
Me.Picture1.Left = (Me.Width / 2) - (Me.Picture1.Width / 2)
Me.Picture1.Top = Me.Height - Me.Picture1.Height - 500
End Sub

Y esto es todo, seguro que se peude mejorar u optimizar.
...

 


 


Código de ejemplo (comprimido):

 

Fichero con el código de ejemplo: F_Manchado_Incrustar_Programa_Sin_Menus.zip - 4.29 KB

(MD5 checksum: 48598D788FCABF3D53267D6EC81CCD7F)

 


Ir al índice principal de el Guille