Date: 02-16-2022
Return to Index
created by gbSnippets
'Credit: Dave Biggs
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global ghDlg As Dword, ghHook As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,400,400, %WS_OverlappedWindow To ghDlg
Control Add Button, ghDlg, 100,"Push", 50,10,100,20
Dialog Show Modal ghDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If Cb.Msg = %WM_Command And Cb.Ctl = 100 And Cb.CtlMsg = %BN_Clicked Then
' Set up the Hook procedure so it is active when the MessageBox events occur
ghHook = SetWindowsHookEx(%WH_CBT, CodePtr(SBProc), GetModuleHandle(""), GetCurrentThreadId) '(could be a macro?)
MessageBox 0, "Continue ?", "Hooked MessageBox - no parent", %MB_IconQuestion Or %MB_OkCancel Or %MB_TaskModal
MessageBox ghDlg, "Continue ?", "Hooked MessageBox - 'owned'", %MB_IconQuestion Or %MB_OkCancel Or %MB_TaskModal
MsgBox "Continue", %MB_ICONEXCLAMATION, "" ' PBWin default caption
UnhookWindowsHookEx ghHook ' delayed removal of hook for example
End If
End Function
Function SBProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Function = CallNextHookEx(ByVal ghHook, ByVal nCode, ByVal wParam, ByVal lParam)
If nCode < 0 Then Exit Function
If nCode = %HCBT_CREATEWND Then ' wParam is hWnd, lParam is a CBT_CREATEWND structure. See CBTProc in SDK docs
Local rc As RECT, p As PointAPI
Local cw As CBT_CREATEWND Ptr, cst As CREATESTRUCT Ptr
Local szTemp As AsciiZ * %Max_Path
Local pszTemp As Asciiz Ptr
cw = lParam ' Get CBT_CREATEWND struct so we can. ' TT: Nick Melnick
cst = @cw.lpcs ' get pointer to CREATESTRUCT struct for each
' window / control as it is created.
GetClassName wParam, szTemp, %Max_Path
If UCase$(szTemp) = "#32770" Then ' Dialog being created
If @cst.hwndParent = %HWND_DESKTOP Then ' Is it an 'orphan' MessageBox or MsgBox..
pszTemp = @cst.lpszName
If @pszTemp = "PowerBASIC" Then ' PB Default MsgBox caption - Owned by Desktop so..
@cst.hwndParent = ghDlg ' change the Parent :)
Else
Exit Function ' Default behaviour for desktop owned messagebox - screen center
End If
End If
GetClientRect @cst.hwndParent, rc
ClientToScreen @cst.hwndParent, p
@cst.x = (rc.nRight - @cst.cx) \ 2 + p.x
@cst.y = (rc.nBottom - @cst.cy) \ 2 + p.y
End If
End If
If nCode = %HCBT_ACTIVATE Then ' (Construction complete) - activating window
'UnhookWindowsHookEx ghHook ' Normally we would remove the hook asap. Here is a good place.
End If
End Function
'gbs_00798
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm