Option Explicit
' Import
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
' Handle to the Hook procedure
Private hHook As Long
' Position
Private msgbox_x As Long
Private msgbox_y As Long
' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1 ' Retains the current size
Private Const SWP_NOZORDER = &H4 ' Retains the current Z order
Sub TestMsgBox()
MsgBoxPos "Set non-Center Position", _
vbOKOnly, _
"Message Box Hooking", _
400, 300
End Sub
Public Sub MsgBoxPos(strPromt As String, _
vbButtons As VbMsgBoxStyle, _
strTitle As String, _
xPos As Long, _
yPos As Long)
' Store position
msgbox_x = xPos
msgbox_y = yPos
' Set Hook
hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
0, _
GetCurrentThreadId)
' Run MessageBox
MsgBox strPromt, vbButtons, strTitle
End Sub
Private Function MsgBoxHookProc(ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
' Change position
SetWindowPos wParam, 0, msgbox_x, msgbox_y, _
0, 0, SWP_NOSIZE + SWP_NOZORDER
' Release the Hook
UnhookWindowsHookEx hHook
End If
MsgBoxHookProc = False
End Function
No comments:
Post a Comment