Trucos Modificar el menu de sistema de un formulario

Este ejemplo usa subclasificación para poder detectar la pulsación de las opciones que hemos añadido en el menú de sistema del formulario, por lo que NO PUEDE PULSAR EL BOTON PARAR DE VB, ya que si lo haces se perderá la referencia a la función que debe procesar los mensajes de windows para ese menú y te dará un "error de protección general" que hará que VB se cierre.

En el formulario declaras :

Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" _
  (ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long, ByVal wIDNewItem As Long, _
  ByVal lpNewItem As Any) As Long

Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function HiliteMenuItem Lib "user32" (ByVal hwnd As Long,
ByVal hMenu As Long, ByVal wIDHiliteItem As Long, ByVal wHilite As Long) As
Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As
Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Type MENUITEMINFO
     cbSize As Long
     fMask As Long
     fType As Long
     fState As Long
     wID As Long
     hSubMenu As Long
     hbmpChecked As Long
     hbmpUnchecked As Long
     dwItemData As Long
     dwTypeData As String
     cch As Long
End Type

Const SC_SIZE As Long = &HF000&
Const SC_SEPARATOR As Long = &HF00F&
Const SC_MOVE As Long = &HF010&
Const SC_MINIMIZE As Long = &HF020&
Const SC_MAXIMIZE As Long = &HF030&
Const SC_CLOSE As Long = &HF060&
Const SC_RESTORE As Long = &HF120&

Const MF_BYCOMMAND As Long = &H0&
Const MF_BYPOSITION As Long = &H400&
Const MF_SEPARATOR As Long = &H800&
Const MF_CHECKED As Long = &H8&
Const MF_DISABLED As Long = &H2&
Const MF_ENABLED As Long = &H0&
Const MF_GRAYED As Long = &H1&
Const MF_HILITE As Long = &H80&

Const MIIM_STATE As Long = &H1&
Const MIIM_ID As Long = &H2&
Const MIIM_SUBMENU As Long = &H4&
Const MIIM_CHECKMARKS As Long = &H8&
Const MIIM_TYPE As Long = &H10&
Const MIIM_DATA As Long = &H20&

Const MFS_DEFAULT As Long = &H1000&

En el evento Load del mismo :

Dim hMenu As Long, Success As Long, DatosMenu As MENUITEMINFO

hMenu = GetSystemMenu(hwnd, 0)
'añado una opción antes del menu cerrar, con un check
Success = InsertMenu(hMenu, SC_CLOSE, MF_BYCOMMAND + MF_CHECKED, 128&,
"Opción &antes de Cerrar")
'añado un separador antes del menu cerrar
Success = InsertMenu(hMenu, SC_CLOSE, MF_BYCOMMAND + MF_SEPARATOR, 0&,
vbNullString)
'añado una opción al final del menú
Success = InsertMenu(hMenu, &HFFFFFFFF, 0&, 131&, "&Penúltima opción")
'añado una opción al final del menú, deshabilitada
Success = InsertMenu(hMenu, &HFFFFFFFF, MF_GRAYED, 129&, "&Última opción")
'añado un separador antes de la opción que acabo de crear
Success = InsertMenu(hMenu, 129&, MF_BYCOMMAND + MF_SEPARATOR, 0&,
vbNullString)
'añado una opción en la posición 2 del menú
Success = InsertMenu(hMenu, 1&, MF_BYPOSITION, 130&, "Opción de la &segunda
línea")
'poner el "fondo azul" en la opción que acabamos de crear
'en realidad no vale para mucho, lo pongo a efectos de demostración
HiliteMenuItem Me.hwnd, hMenu, 1&, MF_BYPOSITION + MF_HILITE

'llamar a DrawMenuBar para que todo se actualice correctamente
DrawMenuBar hMenu

'subclasificar para poder recibir la elección del menú
procOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)

Y en el Unload (muy importante) :

procOld = SetWindowLong(hwnd, GWL_WNDPROC, procOld)


Añades un módulo, y declaras :

Public Const WM_SYSCOMMAND = &H112
Public procOld As Long

Public Declare Function CallWindowProc& Lib "user32" _
Alias "CallWindowProcA" _
  (ByVal lpPrevWndFunc&, _
ByVal hwnd&, ByVal Msg&, _
ByVal wParam&, ByVal lParam&)

Public Declare Function SetWindowLong& Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd&, _
ByVal nIndex&, ByVal dwNewLong&)
Public Const GWL_WNDPROC As Long = (-4&)

Y añades esta función :

Public Function WindowProc(ByVal hwnd As Long, _
ByVal iMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

   Select Case iMsg
      Case WM_SYSCOMMAND
         If wParam = 128 Then 'valor asignado en InsertMenu
             MsgBox "Usted hizo clik en la opción 'Opción antes de cerrar'"
         End If
         If wParam = 129 Then 'valor asignado en InsertMenu
             MsgBox "Usted hizo clik en la opción 'Última opción'"
         End If
         If wParam = 130 Then 'valor asignado en InsertMenu
             MsgBox "Usted hizo clik en la opción 'Opción de la &segunda
línea'"
         End If
         If wParam = 131 Then 'valor asignado en InsertMenu
             MsgBox "Usted hizo clik en la opción 'Penúltima opción'"
         End If

   End Select

   WindowProc = CallWindowProc(procOld, _
     hwnd, iMsg, wParam, lParam)
End Function



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com