Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing SubClassMenuMod.bas (2.58 KB)
Attribute VB_Name = "SubClassMenuMod"
Option Explicit
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_GETMINMAXINFO As Long = &H24
Private Const WM_SYSCOMMAND As Long = &H112
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 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 Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const MF_CHECKED = &H8&
Public Const MF_UNCHECKED = &H0&
Public Const MF_ENABLED = &H0&
Public Const MF_DISABLED = &H2&
Private SubClassObject As Long
Private OldWindowProc As Long
Public Const AboutMenuID As Long = 5000
Public Const AlwaysOnTopMenuID As Long = 5001
Public Const UseHotKeysMenuID As Long = 5002
Public Sub EndSysMenuSubClass()
UnSubClass SubClassObject, OldWindowProc
End Sub
Public Sub StartSysMenuSubClass(ByVal hWnd As Long)
SubClassObject = hWnd
SubClass SubClassObject
End Sub
Private Sub SubClass(hWnd As Long)
On Error Resume Next
OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UnSubClass(hWnd As Long, PrevDefProc As Long)
SetWindowLong hWnd, GWL_WNDPROC, PrevDefProc
End Sub
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If SubClassObject = hWnd Then
Select Case uMsg
Case WM_SYSCOMMAND
Select Case wParam
Case AboutMenuID
MainForm.AboutMenu_Click
Case AlwaysOnTopMenuID
MainForm.AlwaysOnTopMenu_Click
Case UseHotKeysMenuID
MainForm.UseHotKeysMenu_Click
End Select
Case WM_GETMINMAXINFO
WindowProc = 0
Exit Function
End Select
WindowProc = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
End If
End Function