SubClassing




'*****Form1*****'

Option Explicit
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
PostQuitMessage 0&
End Sub

'*****Module1*****'

Option Explicit
Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(lpMsg As msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" _
(lpMsg As msg) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As msg) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Const PM_REMOVE = &H1
Public Const WM_QUIT = &H12
Public Const WM_RBUTTONDOWN = &H204
Private Sub Main()
Dim tMsg As msg
Load Form1
Form1.Show
Do
If PeekMessage(tMsg, 0, 0, 0, PM_REMOVE) Then
If tMsg.message = WM_QUIT Then Exit Do
If tMsg.message = WM_RBUTTONDOWN Then
MsgBox "You clicked the right mousebutton!" & _
vbCr & "Press a key to End the app"
End If
TranslateMessage tMsg
DispatchMessage tMsg
Else
'There's nothing to do for your App!

'In a game you could draw a new frame,

'this is much faster than using the Timer!

End If
Loop Until False
Unload Form1
End Sub











( subclassing.html )- by Paolo Puglisi - Modifica del 17/12/2023