-
Sep 20th, 2023, 06:30 PM
#1
Need a refresher on custom message loops
I want to make a class that registers and creates it's own window, so it can function even in non-GUI apps. The window is non-graphical and hidden, it exists merely to listen for WM_POWERBROADCAST messages, which requires an hwnd unless you run as a service.
Now if this was the only potential window, I could run the loop without issue. But since GetMessage is blocking in a loop that never exits until the process exits, I'm wondering what the proper way to set this up is so it doesn't interfere with VB windows being responsive.
I've considered running it in it's own thread; if I do that, would I have trouble with RaiseEvent? I wouldn't be passing data, it's just to signal the event happened.
Been a long, long time since I did this and it's not easily google-able for VBx considerations.
-
Sep 20th, 2023, 07:45 PM
#2
Re: Need a refresher on custom message loops
The program running in a console decides what appears in that console
This is the console version of a “message loop”: We read input events from the console and respond to them. If the mouse moves, we move the cursor to the mouse position and update the status bar. If the user hits the Escape key, we exit the program.
Look at the sample code before and after that remark.
Raymond uses the phrase "message loop" metaphorically. A program running in the Console subsystem doesn't have a message loop like a program running in the Windows (GDI) subsystem.
If you run this program, you’ll see a happy little status bar at the bottom whose contents continuously reflect the cursor position, which you can move by just waving the mouse around.
If you want a status bar in your console program, go ahead and draw it yourself. Of course, since it’s a console program, your status bar is going to look console-y since all you have to work with are rectangular character cells. Maybe you can make use of those fancy line-drawing characters. Party like it’s 1989!
What you really want is a message queue.
See Capturing Windows Power Events in a Console Application
In fact, the message queue is really the thing that we need in all this so that we can receive the WM_POWERBROADCAST messages. AFAIK, the only ways to get a message queue are via creating a window or running as a service.
So far that reveals nothing you didn't already know. But perhaps he offers a hint or two there that might prove useful in your quest.
-
Sep 20th, 2023, 07:45 PM
#3
Re: Need a refresher on custom message loops
Do you need to create your own window for this? If not, maybe Karl E. Peterson's technique of subclassing ThunderMain to listen for WM_POWERBROADCAST would work instead?
-
Sep 20th, 2023, 08:24 PM
#4
Re: Need a refresher on custom message loops
Sorry if I wasn't clear-- it's not necessarily a console program. I just don't want the class dependent on a GUI program. It might be a regular desktop GUI app, it might be a console app, it might be a windowless service, or just something that runs from Sub Main with no window or console or service. . I want the class module to be portable to any of these types of projects, so it would need to create it's own window.
Once I have the WndProc receiving the message is no problem, indeed I already got that part working just subclassing the form:
Code:
Private m_hEventM As LongPtr
Private m_hEventP As LongPtr
Private m_hEventL As LongPtr
Private Declare Function RegisterPowerSettingNotification Lib "user32" (ByVal hRecipient As LongPtr, PowerSettingGuid As UUID, ByVal Flags As DEVICE_NOTIFY_FLAGS) As LongPtr
Private Declare Function UnregisterPowerSettingNotification Lib "user32" (ByVal Handle As LongPtr) As BOOL
Private Sub Command1_Click()
If RegisterEvents() Then
LogEvent "Registered for events, listening..."
Subclass2 Form1.hWnd, AddressOf PBWndProc, Form1.hWnd
Else
LogEvent "Failed to register for events."
End If
End Sub
Private Function RegisterEvents() As Boolean
m_hEventM = RegisterPowerSettingNotification(Me.hWnd, GUID_SESSION_DISPLAY_STATUS, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventP = RegisterPowerSettingNotification(Me.hWnd, GUID_SESSION_USER_PRESENCE, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventL = RegisterPowerSettingNotification(Me.hWnd, GUID_LIDSWITCH_STATE_CHANGE, DEVICE_NOTIFY_WINDOW_HANDLE)
If m_hEventM Then RegisterEvents = True
End Function
Private Function Subclass2(hWnd As LongPtr, lpFN As LongPtr, Optional uId As LongPtr = 0&, Optional dwRefData As LongPtr = 0&) As Boolean
If uId = 0 Then uId = hWnd
Subclass2 = SetWindowSubclass(hWnd, lpFN, uId, dwRefData): Debug.Assert Subclass2
End Function
Private Function PBWndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr
Select Case uMsg
Case WM_POWERBROADCAST
If wParam = PBT_POWERSETTINGCHANGE Then
Dim pSetting As POWERBROADCAST_SETTING
CopyMemory pSetting, ByVal lParam, 20
If IsEqualGUID(pSetting.PowerSetting, GUID_SESSION_DISPLAY_STATUS) Then
Dim pState As MONITOR_DISPLAY_STATE
CopyMemory pState, ByVal PointerAdd(lParam, 20), 4
Select Case pState
Case PowerMonitorOff
LogEvent "Monitor Off"
Case PowerMonitorOn
LogEvent "Monitor On"
Case PowerMonitorDim
LogEvent "Monitor dimmed"
End Select
...etc
But now I want to move this code to a class module that doesn't rely on having a Form available, and no other way of receiving the message is supported except in services. There's other ways I could get this information but I'd have to create a timer and keep polling; I'd rather do it this way.
The link about doing this in a console app does what I was thinking about-- create it in a new thread. But since threaded vb apps are a pain to debug, I was hoping someone knew the ramifications of calling RaiseEvent cross-thread. I could avoid that, but again either by a blocking call or a timer to poll something.
Last edited by fafalone; Sep 20th, 2023 at 08:37 PM.
-
Sep 20th, 2023, 08:38 PM
#5
Re: Need a refresher on custom message loops
The simplest way is to let it run in multiple threads, and it can handle it perfectly.
It even runs stably on the VB6 IDE.
There is another asynchronous message pattern. Equivalent to doevents. It doesn't even work when there is no message, but it doesn't stutter when you operate the mouse and keyboard.
-
Sep 20th, 2023, 08:40 PM
#6
Re: Need a refresher on custom message loops
You can make the multithreading part a DLL. The operation of VB6 paper flower is mainly to unload these resources cleanly.
-
Sep 21st, 2023, 02:31 AM
#7
Re: Need a refresher on custom message loops
I'm not sure a separate thread is 'simple' in a class module, was just think I'm going to have an issue beyond RaiseEvent in the CreateThread function expecting a different prototype than I think a COM function might have...
Is there a hidden return argument if it's a function? If not it could work by declaring it with no argument, *if* nothing is done with the *this argument that would be dropped to match the prototypes... this is why I didn't want to get into threading.
On the upside, it appears to be a good solution for twinBASIC, which sets up stubs for AddressOf calls, and it's working fine in it's own thread there, but I did want this to be VB6-compatible as well.
-
Sep 21st, 2023, 03:52 AM
#8
Re: Need a refresher on custom message loops
hm.
I think what u need is the Trick to create some "tricks" here so u can do what u need inside a class. (if its even possible)
of what I can understand u need subclassing, so no timer will work here and u can not use a loop or it will freeze it up.
the idea from xiaoyao is good until its not as u already point out.
to have a separate thread would help with the freezing.
but who can create a dynamically thread with the content of a subclass that will return to another thread the raiseevents?
we are talking genius-level now.
TB-approach we dont have. that is why I wrote "tricks".
is it possible to create "a stubs for AddressOf calls" in VB6?
-
Sep 21st, 2023, 07:58 AM
#9
Re: Need a refresher on custom message loops
I'm not sure, why multithreading is even brought up here...
since normal SubClassing works directly on a fresh-CreateWindowEx'd-hWnd without problem...
I'm using this with a "static" WindowClass directly in my (non-UI) TCP-Classes of the RC6 for async Socket-Msg-receiving...
Here's a simple example (using the RC6-Subclasser... please change it to your SubClasser of choice if needed):
cHwndListener.cls
Code:
Option Explicit
Event MsgReceived(ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByVal lpParam As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private mHWnd As Long, WithEvents SC As cSubClass 'use an IDE-save SubClasser of your choice
Private Sub Class_Initialize()
mHWnd = CreateWindowExW(0, StrPtr("static"), StrPtr("MyEventWatcher"), 0, 0, 0, -1, -1, 0, 0, App.hInstance, 0)
If mHWnd Then Set SC = New_c.SubClass: SC.Hook mHWnd
End Sub
Public Property Get hWnd() As Long
hWnd = mHWnd
End Property
Private Sub SC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
If Msg = &HC Then RaiseEvent MsgReceived(wParam, lParam) 'let's react to WM_SETTEXT, raising an Event
Result = SC.CallWindowProc(Msg, wParam, lParam) 'default-msg-handling of this SC-instance
End Sub
Private Sub Class_Terminate()
If mHWnd Then SC.UnHook: DestroyWindow mHWnd
End Sub
And Test-Form-code:
Code:
Option Explicit
Private Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
Private WithEvents Listener As cHwndListener
Private Sub Form_Load()
Set Listener = New cHwndListener
Caption = "Click Me"
End Sub
Private Sub Form_Click() 'show, that msg-recv. via SubClassing works on our static Listener-window
SetWindowTextW Listener.hWnd, StrPtr("Hello_Static")
End Sub
Private Sub Listener_MsgReceived(ByVal wParam As Long, ByVal lParam As Long)
Debug.Print "The Listener.hWnd just received WM_SETTEXT"
End Sub
Olaf
-
Sep 21st, 2023, 10:43 AM
#10
Re: Need a refresher on custom message loops
If I understood the problem correctly you need to process WM_POWERBROADCAST message even if the main thread is in suspended state (sleep/waiting/etc.) and this thread might have NO message pumping loop. Ok?
If so, you definitely need to create a separate thread and call __vbaRaiseEvent from main thread. See this example which creates a thread and when an event occurs it fires the event into the class. However you can't process this event in the main thread because it is in suspended state and has no message loop. If you need to process the message and wait you could use MsgWaitForMultipleObject.
Last edited by The trick; Sep 21st, 2023 at 10:51 AM.
-
Sep 21st, 2023, 06:01 PM
#11
Re: Need a refresher on custom message loops
MsgWaitForMultipleObject,Can I receive this message here? WM _ POWERBROADCAST, after using this API. I won't get the main form stuck. Your keyboard input or other published messages will be available.
I've tested it in a function that lets it receive messages from five timers.For example, two timers with the same frequency are triggered at the same time. Some timer batteries are 100 milliseconds, some are 1000 milliseconds, and some are 1 minute.
When we all enter this stage, such as the adoption of A critical region function,and so on, we have entered the industry of the highest and most difficult code.
Microsoft, the beauty, has been stripped naked by you.
-
Sep 22nd, 2023, 12:31 AM
#12
Re: Need a refresher on custom message loops
@Schmidt; because that's the typical answer found when search for how to create a 2nd message loop.
What's hosting the main message loop for the static control? Presumably defsubclassproc has to be returning to somewhere..? Why doesn't this block when the same thing locally would;
Code:
hr = GetMessage(tMSG, m_hWnd, 0, 0)
Do While hr <> 0
If hr = -1 Then
If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then Exit Do
Else
TranslateMessage tMSG
DispatchMessage tMSG
End If
hr = GetMessage(tMSG, m_hWnd, 0, 0)
Loop
Would much prefer to have the loop from there, but that seem workable.
@The trick - Fascinating example as always, but I'm not sure of the applicability... the main thread would have instantiated the class, and is going about it's normal activity until it gets an event from the class firing RaiseEvent, which.. if it's the main thread calling it, why __vbaRaiseEvent? I would have expected something like that only for the thread I create rather than the original thread. I'm probably not explaining it good... here's a working implementation of what I want to do, I got the new thread based method working in twinBASIC, however I'd like to do it in a way also compatible with VB6...
Code:
[ COMCreatable (False) ]
Class clsPresenceMon
/*
clsPresenceMon - User Presence Monitor
v0.1 (Initial release)
(c) 2023
*/
Public Event MonitorOff()
Public Event MonitorOn()
Public Event MonitorDim()
Public Event UserPresent()
Public Event LidOpen()
Public Event LidClose()
Private m_hWnd As LongPtr
Private m_hInst As LongPtr
Private m_hEventM As LongPtr
Private m_hEventP As LongPtr
Private m_hEventL As LongPtr
Private m_hThread As LongPtr
Private m_idThread As Long
Private Const wndClass = "CPresenceMonWnd"
Private Const wndName = ""
Public Enum CPMonEventNotify
CPMEN_ERROR = 0
CPMEN_MONITOROFF = &H01
CPMEN_MONITORON = &H02
CPMEN_MONITORDIM = &H04
CPMEN_USERPRESENCE = &H08
CPMEN_LIDOPEN = &H10
CPMEN_LIDCLOSE = &H20
CPMEN_ALL = (-1)
End Enum
Private m_Mask As CPMonEventNotify
Private Type ConfigData
hWnd As LongPtr
hInst As LongPtr
Mask As CPMonEventNotify
End Type
Private tConfig As ConfigData
Sub New(Optional ByVal dwNotifyMask As CPMonEventNotify = CPMEN_ALL, Optional ByVal hInst As LongPtr)
m_hInst = If(hInst = 0, GetModuleHandleW(), hInst)
If dwNotifyMask = CPMEN_ERROR Then Exit Sub
m_Mask = dwNotifyMask
tConfig.hInst = m_hInst
tConfig.Mask = m_Mask
m_hThread = CreateThread(ByVal 0, 0, AddressOf CPMonProc, tConfig, 0, m_idThread)
End Sub
Private Function CPMonProc(pConfig As ConfigData) As Long
CoInitialize ByVal 0
If CreateApplicationWindow(pConfig) Then
If RegisterEvents() = False Then
PostLog "Failed to register events."
DestroyWindow m_hWnd
m_hWnd = 0
Return E_ABORT
End If
EnterMessageLoop
End If
CoUninitialize
End Function
Private Sub PostLog(sMsg As String)
Debug.Print sMsg
End Sub
Private Function RegisterEvents() As Boolean
m_hEventM = RegisterPowerSettingNotification(m_hWnd, GUID_SESSION_DISPLAY_STATUS, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventP = RegisterPowerSettingNotification(m_hWnd, GUID_SESSION_USER_PRESENCE, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventL = RegisterPowerSettingNotification(m_hWnd, GUID_LIDSWITCH_STATE_CHANGE, DEVICE_NOTIFY_WINDOW_HANDLE)
If m_hEventM Then Return True
End Function
Private Sub UnregisterEvents()
If m_hEventM Then UnregisterPowerSettingNotification(m_hEventM): m_hEventM = 0
If m_hEventP Then UnregisterPowerSettingNotification(m_hEventP): m_hEventP = 0
If m_hEventL Then UnregisterPowerSettingNotification(m_hEventL): m_hEventL = 0
End Sub
Private Function CreateApplicationWindow(pConfig As ConfigData) As Long
Dim hr As Long = S_OK
Dim wcex As WNDCLASSEX
wcex.cbSize = LenB(wcex)
wcex.style = CS_HREDRAW Or CS_VREDRAW
wcex.lpfnWndProc = AddressOf WindowProc
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = m_hInst
wcex.hIcon = 0
wcex.lpszMenuName = 0
wcex.lpszClassName = StrPtr(wndClass)
wcex.hIconSm = 0
hr = IIf(RegisterClassEx(wcex), S_OK, E_FAIL)
If Err.LastDllError = ERROR_CLASS_ALREADY_EXISTS Then
PostLog "ERROR_CLASS_ALREADY_EXISTS; registering."
UnregisterClassW StrPtr(wndClass), m_hInst
hr = IIf(RegisterClassEx(wcex), S_OK, E_FAIL)
End If
If SUCCEEDED(hr) Then
Dim dwStyle As WindowStyles
'If pConfig.hWnd Then dwStyle = WS_CHILD
dwStyle = dwStyle Or WS_CLIPSIBLINGS Or WS_OVERLAPPED
m_hWnd = CreateWindowExW(0, StrPtr(wndClass), StrPtr(wndName), dwStyle, _
CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, pConfig.hWnd, 0, pConfig.hInst, ByVal 0)
If m_hWnd Then Return 1
Else
Debug.Print "Failed to register window class."
End If
End Function
Private Function EnterMessageLoop() As Long
Dim result As Long
Dim tMSG As MSG
Dim hr As Long
PostLog "Entering message loop"
hr = GetMessage(tMSG, m_hWnd, 0, 0)
Do While hr <> 0
If hr = -1 Then
PostLog "Error: 0x" & Hex$(Err.LastDllError)
If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then Exit Do
Else
TranslateMessage tMSG
DispatchMessage tMSG
End If
hr = GetMessage(tMSG, m_hWnd, 0, 0)
Loop
PostLog "Exited message loop"
result = CLng(tMSG.wParam)
EnterMessageLoop = result
End Function
Private Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim result As LongPtr
Select Case uMsg
Case WM_CREATE
PostLog "WM_CREATE"
Case WM_POWERBROADCAST
If wParam = PBT_POWERSETTINGCHANGE Then
Dim pSetting As POWERBROADCAST_SETTING
CopyMemory pSetting, ByVal lParam, 20
If IsEqualGUID(pSetting.PowerSetting, GUID_SESSION_DISPLAY_STATUS) Then
Dim pState As MONITOR_DISPLAY_STATE
CopyMemory pState, ByVal PointerAdd(lParam, 20), 4
Select Case pState
Case PowerMonitorOff
If (m_Mask And CPMEN_MONITOROFF) Then RaiseEvent MonitorOff()
Case PowerMonitorOn
If (m_Mask And CPMEN_MONITORON) Then RaiseEvent MonitorOn()
Case PowerMonitorDim
If (m_Mask And CPMEN_MONITORDIM) Then RaiseEvent MonitorDim()
End Select
ElseIf IsEqualGUID(pSetting.PowerSetting, GUID_SESSION_USER_PRESENCE) Then
Dim pPres As USER_ACTIVITY_PRESENCE
CopyMemory pState, ByVal PointerAdd(lParam, 20), 4
If (m_Mask And CPMEN_USERPRESENCE) Then RaiseEvent UserPresent()
ElseIf IsEqualGUID(pSetting.PowerSetting, GUID_LIDSWITCH_STATE_CHANGE) Then
Dim fOpen As BOOL
If pSetting.DataLength <> 4 Then
Debug.Print "Bad lid size"
Else
CopyMemory fOpen, ByVal PointerAdd(lParam, 20), 4
If fOpen Then
If (m_Mask And CPMEN_LIDOPEN) Then RaiseEvent LidOpen()
Else
If (m_Mask And CPMEN_LIDCLOSE) Then RaiseEvent LidClose()
End If
End If
End If
End If
Case WM_CLOSE
DestroyWindow m_hWnd
Case WM_DESTROY
UnregisterEvents
PostQuitMessage 0
Case Else
result = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Select
WindowProc = result
End Function
Public Sub Destroy()
If m_hWnd Then PostMessageW(m_hWnd, WM_CLOSE, 0, ByVal 0)
Dim lRet As WaitForObjOutcomes = WaitForSingleObject(m_hThread, 5000)
Debug.Print "Wait outcome=" & lRet
Dim hr As Long = UnregisterClassW(StrPtr(wndClass), m_hInst)
Debug.Print "Unregister hr=" & hr & ", lastErr=" & Err.LastDllError
End Sub
End Class
Form:
Code:
Private WithEvents CMon As clsPresenceMon
Private Sub Command3_Click() Handles Command3.Click
Set CMon = New clsPresenceMon(CPMEN_ALL, App.hInstance)
End Sub
Private Sub CMon_MonitorOff() Handles CMon.MonitorOff
LogEvent "Monitor Off"
End Sub
'other events
Private Sub Command4_Click() Handles Command4.Click
CMon.Destroy
Set CMon = Nothing
End Sub
(Full test project)
Last edited by fafalone; Sep 22nd, 2023 at 12:40 AM.
-
Sep 22nd, 2023, 04:34 AM
#13
Re: Need a refresher on custom message loops
fafalone, you use RaiseEvent from another thread but the class instance lives in the main thread. All the VB6 classes are STA ones so you can't do it using this way because the event is generated in the new thread when the subscriber expects call in its own thread. If you want to use normal classes and follow COM-STA rules your subscriber thread should implement message loop (it's the COM rules) to receive events/proper marshaling. For example if the main thread calls WaitForSingleObject the event couldn't be processed because the thread is in the waiting state. You could use free-threading method but you can't use WithEvents then. To see the method see here (InitCurrentThreadAndCallFunction) - your callbacks are processed in the new thread.
-
Sep 22nd, 2023, 05:25 AM
#14
Re: Need a refresher on custom message loops
I created a class inside the main form to support events. Then perform some stuttering operations in the multi-thread. Well, you can return the data to this so that it works normally. The event runs inside the main form.
-
Sep 22nd, 2023, 06:52 AM
#15
Re: Need a refresher on custom message loops
 Originally Posted by fafalone
@Schmidt; because that's the typical answer found when search for how to create a 2nd message loop.
Not always, because there's "secondary MessageLoops" which do not run on other threads
(as e.g. when modal-windows are shown, or when Menus are triggered)
 Originally Posted by fafalone
What's hosting the main message loop for the static control?
...
Why doesn't this block when the same thing locally would;
I'd not consider this "static CreateWindowEx'd hWnd" a "Control" -
because no "siting" is involved - it is just acting as a "Msg-receiver"...
And this doesn't block, because in VB6 (as well as in TwinBasic) -
there's always a Main-MessagePump already running on the main-thread.
Therefore "plain subclassing" is entirely sufficient in my opinion, to tackle this problem -
(no need to "overcomplicate and destabilize" the whole thing with "extra-threading").
For the rare case the Main-thread is currently "blocking"...
there's no need to worry either that a potentially posted WM_POWERBROADCAST will be lost -
because of "default-Msg-Queueing"...
Meaning, as soon as the main-thread becomes "responsive" again (getting back to Msg-Pumping) -
the queued Messages it received during the blocking-period will be delivered to all receiver-hWnds.
Here's an updated Demo, which shows this:
cHwndListener
Code:
Option Explicit
Event MsgReceived(ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByVal lpParam As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private mHWnd As Long, WithEvents SC As cSubClass 'use an IDE-save SubClasser of your choice
Private Sub Class_Initialize()
mHWnd = CreateWindowExW(0, StrPtr("static"), StrPtr("MyEventWatcher"), 0, 0, 0, -1, -1, 0, 0, App.hInstance, 0)
If mHWnd Then Set SC = New_c.SubClass: SC.Hook mHWnd
End Sub
Public Property Get hWnd() As Long
hWnd = mHWnd
End Property
Private Sub SC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Const WM_POWERBROADCAST As Long = &H218
If Msg = WM_POWERBROADCAST Then
RaiseEvent MsgReceived(wParam, lParam)
End If
Result = SC.CallWindowProc(Msg, wParam, lParam) 'default-msg-handling of this SC-instance
End Sub
Private Sub Class_Terminate()
If mHWnd Then SC.UnHook: DestroyWindow mHWnd
End Sub
And the matching Form-Code fore testing (simulating a 3000msec blocking-interval):
Code:
Option Explicit
Private Declare Function PostMessageW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private WithEvents Listener As cHwndListener
Private Sub Form_Load()
Set Listener = New cHwndListener
Caption = "Click Me"
End Sub
Private Sub Form_Click() 'show, that msg-recv. via SubClassing works on our static Listener-window
Me.Cls: Print "the main-thread will now block for 3 seconds, until the Event will be reported..."
Const WM_POWERBROADCAST As Long = &H218
PostMessageW Listener.hWnd, WM_POWERBROADCAST, 0, 0 'let's post a simple Msg asynchronously to our Listener-hWnd
New_c.SleepEx 3000 'and immediately block this thread for 3 seconds (the Listener_MsgReceived will still be received after that "blocking-interval")
End Sub
Private Sub Listener_MsgReceived(ByVal wParam As Long, ByVal lParam As Long)
Me.Cls: Print "The Listener.hWnd just detected a (queued) WM_POWERBROADCAST"
End Sub
Edit: accidentally posted a duplicate of the Form-Code into the cHwndListener Code-Section... (fixed now)
Olaf
Last edited by Schmidt; Sep 24th, 2023 at 12:34 AM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|