ExcelBanter - API Call from VBA crashing Excel

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - API Call from VBA crashing Excel (https://www.excelbanter.com/excel-programming/327740-api-call-vba-crashing-excel.html)

API Call from VBA crashing Excel

Hi all,

I am trying to center a Windows Common Dialog using the API call. Trouble
is, when the code gets to 'SetWindowsHookEx' below it is crashing...

CODE
' Set up the CBT hook to center the dialog on the screen when Windows
' sends the message that is fully drawn...
Debug.Print "ThreadID:" & GetCurrentThreadId()
Debug.Print "hWnd:" & FindWindow("ThunderDFrame", Me.Caption)

hHook = SetWindowsHookEx(WH_CBT, _
AddressOf
modAPICommonDialogLib.WinProcCenterScreen, _
GetWindowLong(FindWindow("ThunderDFrame",
Me.Caption), GWL_HINSTANCE), _
GetCurrentThreadId())
<<< CODE <<<<
here is the procedure pointed at by the 'AddressOf' function call:

CODE
Public Function WinProcCenterScreen(ByVal lMsg As Long, ByVal wParam As
Long, ByVal lParam As Long, xForm As UserForm) As Long
'================================================= ===='
' Developer : Philip Livingstone
' Workstation :
'
' Purpose : Uses the API to centre a modal system dialog on the
screen...
' Parameters : lMsg, passed in using the AddressOf function, basically
we're
' subclassing the form...
' lParam, passed in using the AddressOf function...
' Returns : WinProcCenterForm - Long
'
'================================================= ====
Dim rectForm As RECT, rectMsg As RECT
Dim X As Long, Y As Long
If lMsg = HCBT_ACTIVATE Then
' Windows is about to activate the form that we're subclassing...and
we have
' applied a hook to it, to run this code when Windows sends the
message...
' Show the MsgBox at a fixed location (0,0)
GetWindowRect wParam, rectMsg
X = rectMsg.left
Y = rectMsg.top
SetWindowPos wParam, 0, X, Y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or
SWP_NOACTIVATE
'Release the CBT hook
UnhookWindowsHookEx hHook
End If
WinProcCenterScreen = False
End Function
<<< END CODE<<<

Can anyone help me find out what I am doing wrong - for example, should I be
including parameters in the WinProcCenterScreen AddressOf call?

thanks

Philip

API Call from VBA crashing Excel

API Call from VBA crashing Excel

Philip,

this will hook and center a msgbox over a userform.
I assume you'll adapt from msgbox to Dialog y'self :)

Note:
I dont use the xForm argument in the subclassed proc,
instead I set the form's object reference via a public variable.

I've wrapped the form's window handle via property get
(convenience only).

In a form:

Option Explicit

Public Property Get Hwnd()
'returns the window handle of the form
Hwnd = FindWindow("ThunderDFrame", Me.Caption)
End Property

Sub Userform_click()
Set oForm = Me
'set the hook
hHook = SetWindowsHookEx(WH_CBT, _
AddressOf WinProcCenterOnForm, _
GetWindowLong(Me.Hwnd, GWL_HINSTANCE), _
GetCurrentThreadId())

Call MsgBox("Hello")
End Sub

In the public Module
Option Explicit
'...
'(declarations, types and constants omitted)
'...

Public hHook As Long
Public oForm As Object

Public Function WinProcCenterOnForm(ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Dim rectMsg As RECT
Dim rectFrm As RECT
Dim x As Long, y As Long

If lMsg = HCBT_ACTIVATE And wParam < Application.Hwnd Then
'checking on wParam needed for modeless forms.

'the (default) rect of the window being shown
GetWindowRect wParam, rectMsg
'the rect of the userform i want to use for centering
If Not oForm Is Nothing Then
GetWindowRect oForm.Hwnd, rectFrm
End If

x = (rectFrm.Left + rectFrm.Right) \ 2 - _
(rectMsg.Right - rectMsg.Left) \ 2
Y = (rectFrm.Top + rectFrm.Bottom) \ 2 - _
(rectMsg.Bottom - rectMsg.Top) \ 2

SetWindowPos wParam, 0, x, y, 0, 0, _
SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
'Release the hook
UnhookWindowsHookEx hHook
End If

WinProcCenterOnForm = False
End Function

hth..

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

Philip wrote :

Hi all,

I am trying to center a Windows Common Dialog using the API call.
Trouble is, when the code gets to 'SetWindowsHookEx' below it is
crashing...

CODE
' Set up the CBT hook to center the dialog on the screen when
Windows ' sends the message that is fully drawn...
Debug.Print "ThreadID:" & GetCurrentThreadId()
Debug.Print "hWnd:" & FindWindow("ThunderDFrame", Me.Caption)

hHook = SetWindowsHookEx(WH_CBT, _
AddressOf
modAPICommonDialogLib.WinProcCenterScreen, _

GetWindowLong(FindWindow("ThunderDFrame", Me.Caption),
GWL_HINSTANCE), _
GetCurrentThreadId()) <<< CODE <<<<
here is the procedure pointed at by the 'AddressOf' function call:

CODE
Public Function WinProcCenterScreen(ByVal lMsg As Long, ByVal wParam
As Long, ByVal lParam As Long, xForm As UserForm) As Long
'================================================= ===='
' Developer : Philip Livingstone
' Workstation :
'
' Purpose : Uses the API to centre a modal system dialog on
the screen...
' Parameters : lMsg, passed in using the AddressOf function,
basically we're
' subclassing the form...
' lParam, passed in using the AddressOf
function... ' Returns : WinProcCenterForm - Long
'
'================================================= ====
Dim rectForm As RECT, rectMsg As RECT
Dim X As Long, Y As Long
If lMsg = HCBT_ACTIVATE Then
' Windows is about to activate the form that we're
subclassing...and we have
' applied a hook to it, to run this code when Windows sends
the message...
' Show the MsgBox at a fixed location (0,0)
GetWindowRect wParam, rectMsg
X = rectMsg.left
Y = rectMsg.top
SetWindowPos wParam, 0, X, Y, 0, 0, SWP_NOSIZE Or
SWP_NOZORDER Or SWP_NOACTIVATE
'Release the CBT hook
UnhookWindowsHookEx hHook
End If
WinProcCenterScreen = False
End Function
<<< END CODE<<<

Can anyone help me find out what I am doing wrong - for example,
should I be including parameters in the WinProcCenterScreen AddressOf
call?

thanks

Philip

API Call from VBA crashing Excel