Úprava systémového menu okna

Potřebujete změnit vlastnosti systémového menu okna (po kliknutí na ikonu v levém horním rohu)? Pokud využijeme služeb Win32API, není to zase tak složité.

Do modulu vložíme:

Option Explicit
  
'Nadefinujeme konstanty
Public Const WM_SYSCOMMAND As Long = &H112&
Public Const IDM_ABOUT As Long = 1&
Public Const IDM_COMP As Long = 2&
Public Const IDM_CLOSE As Long = 3&
  
'Adresa původní obsluhy eventů menu
Public procOld As Long
  
'Nadefinujeme funkci
Public Declare Function CallWindowProc& Lib "user32" _
   Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, _
   ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
  
'Toto je důležitá funkce obsluhující eventy nového menu
Public Function MenuProc(ByVal hWnd As Long, _
   ByVal iMsg As Long, ByVal wParam As Long, _
   ByVal lParam As Long) As Long
  
  Select Case iMsg
    Case WM_SYSCOMMAND 'Je to ten správný event ?
      
      'A už jen zjistit který a obsloužit ho
      If wParam = IDM_ABOUT Then _
         MsgBox "Zmena Systémového menu", vbOKOnly, "About"

      If wParam = IDM_COMP Then _
          MsgBox "http://www.rakodev.cz", _
          vbInformation, "Firemní prezentace na adrese:"
          
      If wParam = IDM_CLOSE Then _
          Unload frmSysMenu
  End Select
  
  'A samozřejmě volat původní obsluhu
  MenuProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)

End Function

Do formuláře vložíme:

Option Explicit
   
  'Konstanty
  Private Const SC_SIZE As Long = &HF000&
  Private Const SC_MOVE As Long = &HF010&
  Private Const SC_CLOSE As Long = &HF060&
  Private Const SC_MINIMIZE As Long = &HF020&
  Private Const SC_MAXIMIZE As Long = &HF030&
  Private Const SC_NEXTWINDOW As Long = &HF040&
  Private Const SC_PREVWINDOW As Long = &HF050&
  Private Const MF_BYCOMMAND As Long = &H0&
  Private Const MF_STRING As Long = &H0&
  Private Const MF_SEPARATOR As Long = &H800&
  Private Const GWL_WNDPROC As Long = (-4&)
    
  'Deklarace funkci API
  Private Declare Function GetSystemMenu Lib "user32" ( _
                             ByVal hWnd As Long, _
                             ByVal bRevert As Long) As Long
  Private Declare Function DeleteMenu Lib "user32" ( _
                             ByVal hMenu As Long, _
                             ByVal nPosition As Long, _
                             ByVal wFlags As Long) As Long
  
  Private Declare Function AppendMenu Lib "user32" _
                             Alias "AppendMenuA" ( _
                             ByVal hMenu As Long, _
                             ByVal wFlags As Long, _
                             ByVal wIDNewItem As Long, _
                             lpNewItem As Any) 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 Sub Command1_Click()
  Unload Me 'Ukončení programu
End Sub

Private Sub Form_Load()
  Dim hSysMenu As Long
  
  'Které menu chceme editovat - systémové
  hSysMenu = GetSystemMenu(hWnd, False)
  
  'Smažeme některé položky z menu
  Call DeleteMenu(hSysMenu, SC_CLOSE, MF_BYCOMMAND)
  Call DeleteMenu(hSysMenu, SC_SIZE, MF_BYCOMMAND)
  Call DeleteMenu(hSysMenu, SC_MOVE, MF_BYCOMMAND)
  

  'Přidáme svoje
  Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, _
     ByVal "&O programu ...")
  'I oddělovací linku
  Call AppendMenu(hSysMenu, MF_SEPARATOR, False, ByVal 0&)
  Call AppendMenu(hSysMenu, MF_STRING, IDM_COMP, ByVal "&Firma ...")
  Call AppendMenu(hSysMenu, MF_SEPARATOR, False, ByVal 0&)
  Call AppendMenu(hSysMenu, MF_STRING, IDM_CLOSE, ByVal "&Konec")
  
  'Nastavíme funkci, která bude obsluhovat eventy
  ' menu a zároveň ulozime starou
  procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MenuProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  'Nakonec vrátíme původní obsluhu
  Call SetWindowLong(hWnd, GWL_WNDPROC, procOld)
End Sub