Ejemplos usando el Api de windows para Visual basic

139 - Hook para impedir el cambio de tamaño de una ventana - formulario

Volver al Listado Api - Anterior - Siguiente

Contenido

Ejemplo 1
Ejemplo 2
Relacionados

Ejemplo 1

Este ejemplo está interesante para cuando se quiere impedir que el usuario cambie de tamaño un formulario o ventana. Aunque se puede utilizar la propiedad BorderStyle en fixed, estos no permiten maximizar o minimizar la ventana, ya que dichos botones desaparecen al establecer la propiedad . Pero implementando un Hook, si es posible.

Para iniciar el procedimiento que procesa los mensajes, se debe pasar el Hwnd del formulario

Nota: El procedimiento que hace el gancho a los mensajes de windows ( el Hook ), si o se debe estar en un módulo bas. y no se puede interrumpir la ejecución del mismo.

Código en un Formulario para iniciar el Hook

Private Sub Form_Load()
    
    o_win = SetWindowLong(hwnd, -4, AddressOf Hook)

End Sub

Código fuente en el módulo BAS:

Option Explicit Public o_win As Long Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal msg As Long, _ ByVal wParam As Long, _ lParam As WINDOWPOS) As Long Type WINDOWPOS hwnd As Long hWndInsertAfter As Long x As Long y As Long cx As Long cy As Long flags As Long End Type Public Function Hook( _ ByVal hwnd As Long, _ ByVal mensaje As Long, _ ByVal wParam As Long, _ lParam As WINDOWPOS) As Long If mensaje = &H82 Then Call SetWindowLong(hwnd, -4, o_win) If mensaje = &H112 Then If (wParam And &HFFF0) = &HF000& Then Exit Function End If End If Hook = CallWindowProc( _ o_win, _ hwnd, _ mensaje, _ wParam, _ lParam) End Function

Ejemplo 2

Ejemplo enviado por Juan Paz , que permite subclasificar un formulario o ventana de windows para impedir el redimensionado

El ejemplo es un formulario con tres botones. El primer botón, hace que el form se puede redimensionar, pero limitando el ancho y alto minimo. El segundo Botón, permite agrandar el form hasta un cierto límite. La última opción, directamente no permite modificar el tamaño de la ventana

Coloca tres commandbutton ( Command1(0), Command1(1) y Command1(2)) como este gráfico

Código fuente en el formulario

Option Explicit Private StartupHeight As Long Private StartupWidth As Long Private Sub Form_Load() StartupWidth = Me.Width \ Screen.TwipsPerPixelX StartupHeight = Me.Height \ Screen.TwipsPerPixelY Command1(0).Caption = " No se puede agrandar " Command1(1).Caption = " No se puede reducir " Command1(2).Caption = " Ninguna de las dos " Command1_Click 0 ' subclasifica esta ventana ( Form1) Call SubClass(Form1.hwnd) End Sub Private Sub Form_Unload(Cancel As Integer) Call UnSubClass(Me.hwnd) End Sub Private Sub Command1_Click(Index As Integer) Select Case Index ' Esta opción hace que la ventana solo se puede redimensionar _ achicandola, pero no agrandarla Case 0 minX = 0 minY = 0 maxX = StartupWidth maxY = StartupHeight ' la ventana se puede agrandar pero no achicar Case 1 minX = StartupWidth minY = StartupHeight maxX = Screen.Width \ Screen.TwipsPerPixelX maxY = Screen.Height \ Screen.TwipsPerPixelY ' la ventana no se puede redimensionar o cambiar de tamaño Case 2 minX = Me.Width \ Screen.TwipsPerPixelX minY = Me.Height \ Screen.TwipsPerPixelY maxX = Me.Width \ Screen.TwipsPerPixelX maxY = Me.Height \ Screen.TwipsPerPixelY End Select End Sub

Agregar un módulo bas

Option Explicit ' declaracions Api ''''''''''''''''''''''''''''' Public defWindowProc As Long Public minX As Long Public minY As Long Public maxX As Long Public maxY As Long Public Const GWL_WNDPROC As Long = (-4) Public Const WM_GETMINMAXINFO As Long = &H24 Public Type POINTAPI x As Long y As Long End Type Type MINMAXINFO ptReserved As POINTAPI ptMaxSize As POINTAPI ptMaxPosition As POINTAPI ptMinTrackSize As POINTAPI ptMaxTrackSize As POINTAPI End Type Public Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Declare Function CallWindowProc Lib "user32" _ Alias "CallWindowProcA" _ (ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) ''''''''''''''''''''''''''''''''''''''''''''' 'Subclasifica el form '''''''''''''''''''''''' Public Sub SubClass(hwnd As Long) On Error Resume Next defWindowProc = SetWindowLong(hwnd, _ GWL_WNDPROC, _ AddressOf WindowProc) End Sub 'Finaliza ''''''''''''''''''''''''' Public Sub UnSubClass(hwnd As Long) If defWindowProc Then SetWindowLong hwnd, GWL_WNDPROC, defWindowProc defWindowProc = 0 End If End Sub ' IMPORTANTE : Indicar en este procedimiento, el formulario a usar ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function WindowProc(ByVal hwnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long On Error Resume Next Select Case hwnd Case Form1.hwnd On Error Resume Next Select Case uMsg Case WM_GETMINMAXINFO Dim MMI As MINMAXINFO CopyMemory MMI, ByVal lParam, LenB(MMI) With MMI .ptMinTrackSize.x = minX .ptMinTrackSize.y = minY .ptMaxTrackSize.x = maxX .ptMaxTrackSize.y = maxY End With CopyMemory ByVal lParam, MMI, LenB(MMI) WindowProc = 0 Case Else WindowProc = CallWindowProc(defWindowProc, _ hwnd, _ uMsg, _ wParam, _ lParam) End Select End Select End Function

Enlaces relacionados

Buscar en Recursos vb