Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

Window Spy

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


Download SubClassMenuMod.bas

Back to file list


Back to project page