| {\rtf1\ansi\ansicpg1252\deff0\deflang1044{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}} \viewkind4\uc1\pard\f0\fs17 You can create a CBT hook for your application so that it receives notifications when windows are created and destroyed. If you display a message box with this CBT hook in place, your application will receive a HCBT_ACTIVATE message when the message box is activated. Once you receive this HCBT_ACTIVATE message, you can position the window with the SetWindowPos API function and then release the CBT hook if it is no longer needed. See the "Test" routine for a demonstration. \par \par 'PLACE CODE IN A STANDARD MODULE \par \par Option Explicit \par \par Public Enum ePosMsgBox \par eTopLeft \par eTopRight \par eTopCentre \par eBottomLeft \par eBottomRight \par eBottomCentre \par eCentreScreen \par eCentreDialog \par End Enum \par \par Private Type RECT \par Left As Long \par Top As Long \par Right As Long \par Bottom As Long \par End Type \par \par 'Message API and constants \par Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal zlhHook As Long) As Long \par Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long \par Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long \par 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 \par 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 \par Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long \par Private Const GWL_HINSTANCE = (-6) \par Private Const SWP_NOSIZE = &H1 \par Private Const SWP_NOZORDER = &H4 \par Private Const SWP_NOACTIVATE = &H10 \par Private Const HCBT_ACTIVATE = 5 \par Private Const WH_CBT = 5 \par \par 'Other APIs \par Private Declare Function GetForegroundWindow Lib "user32" () As Long \par Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long \par \par Private zlhHook As Long \par Private zePosition As ePosMsgBox \par \par \par 'Purpose : Displays a msgbox at a specified location on the screen \par 'Inputs : As per a standard MsgBox + \par ' Position An enumerated type which controls the screen position of the MsgBox \par 'Outputs : As per a standard Msgbox \par 'Notes : VB only, doesn't work in VBA \par \par Function MsgboxEx(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title, Optional HelpFile, Optional Context, Optional Position As ePosMsgBox = eCentreScreen) As VbMsgBoxResult \par Dim lhInst As Long \par Dim lThread As Long \par \par 'Set up the CBT hook \par lhInst = GetWindowLong(GetForegroundWindow, GWL_HINSTANCE) \par lThread = GetCurrentThreadId() \par zlhHook = SetWindowsHookEx(WH_CBT, AddressOf zWindowProc, lhInst, lThread) \par \par zePosition = Position \par \par 'Display the message box \par MsgboxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context) \par End Function \par \par 'Call back used by MsgboxEx \par Private Function zWindowProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long \par Dim tFormPos As RECT, tMsgBoxPos As RECT, tScreenWorkArea As RECT \par Dim lLeft As Long, lTop As Long \par \par If lMsg = HCBT_ACTIVATE Then \par 'on error resume next \par 'A new dialog has been displayed \par tScreenWorkArea = ScreenWorkArea \par 'Get the coordinates of the form and the message box so that \par 'you can determine where the center of the form is located \par GetWindowRect GetForegroundWindow, tFormPos \par GetWindowRect wParam, tMsgBoxPos \par \par Select Case zePosition \par Case eCentreDialog \par lLeft = (tFormPos.Left + (tFormPos.Right - tFormPos.Left) / 2) - ((tMsgBoxPos.Right - tMsgBoxPos.Left) / 2) \par lTop = (tFormPos.Top + (tFormPos.Bottom - tFormPos.Top) / 2) - ((tMsgBoxPos.Bottom - tMsgBoxPos.Top) / 2) \par \par Case eCentreScreen \par lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2 \par lTop = ((tScreenWorkArea.Bottom - tScreenWorkArea.Top) - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)) / 2 \par \par \par Case eTopLeft \par lLeft = tScreenWorkArea.Left \par lTop = tScreenWorkArea.Top \par \par Case eTopRight \par lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left) \par lTop = tScreenWorkArea.Top \par \par Case eTopCentre \par lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2 \par lTop = tScreenWorkArea.Top \par \par \par Case eBottomLeft \par lLeft = tScreenWorkArea.Left \par lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) \par \par Case eBottomRight \par lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left) \par lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) \par \par Case eBottomCentre \par lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2 \par lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) \par \par End Select \par \par 'Position the msgbox \par SetWindowPos wParam, 0, lLeft, lTop, 10, 10, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE \par \par 'Release the CBT hook \par UnhookWindowsHookEx zlhHook \par End If \par zWindowProc = False \par \par End Function \par \par \par 'Purpose : Returns the screen dimensions, not including the tastbar \par 'Inputs : N/A \par 'Outputs : A type which defines the extent of the screen work area. \par \par \par Function ScreenWorkArea() As RECT \par Dim tScreen As RECT \par Dim lRet As Long \par Const SPI_GETWORKAREA = 48 \par \par lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, tScreen, 0) \par ScreenWorkArea = tScreen \par End Function \par \par \par 'Demonstration routine \par Sub Test() \par MsgboxEx "Hello BottomCentre", , , , , eBottomCentre \par MsgboxEx "Hello BottomLeft", , , , , eBottomLeft \par MsgboxEx "Hello BottomRight", , , , , eBottomRight \par MsgboxEx "Hello CentreDialog", , , , , eCentreDialog \par MsgboxEx "Hello CentreScreen", , , , , eCentreScreen \par MsgboxEx "Hello TopCentre", , , , , eTopCentre \par MsgboxEx "Hello TopLeft", , , , , eTopLeft \par MsgboxEx "Hello TopRight", , , , , eTopRight \par End Sub \par } |
Controlling the position of a MsgBox |
India web developer web development India | India web development company India ecommerce web developer