Center a Message Box over a Form

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Intermediate

Author:

Intelligent Solutions Inc.

Version Compatibility: Visual Basic 5

More information:

This code will position a message box in the center of the form. Requires VB5 or higher. Read the comments for instructions regarding how to use.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal plMsgHook As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd _ As Long, lpRect As RECT) As Long Private Const GWL_HINSTANCE = (-6) Private Const SWP_NOSIZE = &H1 Private Const SWP_NOZORDER = &H4 Private Const SWP_NOACTIVATE = &H10 Private Const HCBT_ACTIVATE = 5 Private Const WH_CBT = 5 Private plMsgHook As Long

Code:

Public Function CenterMessageBox(frmHwnd As Long)
'******************************
'WARNING: NOT FOLLOWING BELOW INSTRUCTIONS EXACTLY
'COULD CRASH YOUR APPLICATION

'INSTRUCTIONS:

'1. YOU MUST PUT ALL THIS CODE IS A .BAS MODULE

'2. YOU CALL THIS CODE IMMEDIATELY BEFORE DISPLAYING A MSGBOX,

'3.  PASS IN THE hWnd Property of Form as parameter

'Example:

'CenterMessageBox me.hwnd
'MsgBox "This is a centered Message Box"
'*********************************
Dim lInstance As Long
Dim lThreadID As Long

'Set up message hook
lInstance = GetWindowLong(frmHwnd, GWL_HINSTANCE)
lThreadID = GetCurrentThreadId()
plMsgHook = SetWindowsHookEx(WH_CBT, _
   AddressOf CenterMsgCallBack, lInstance, lThreadID)

End Function

Private Function CenterMsgCallBack(ByVal lMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long

Dim typFormRect As RECT
Dim typRectMsg As RECT
Dim lxPos As Long, lyPos As Long

'HCBT_ACTIVATE = MSG SENT WHEN MSGBOX IS ACTIVATED
   'wParam = handle to msgbox
   If lMsg = HCBT_ACTIVATE Then
        'resolve center of form
        
        'form rectangle
      GetWindowRect Form1.hwnd, typFormRect
      
        'msgbox rectangle
      GetWindowRect wParam, typRectMsg
      
      'Determine x and y
      lxPos = (typFormRect.Left + _
           (typFormRect.Right - typFormRect.Left) / 2) - _
           ((typRectMsg.Right - typRectMsg.Left) / 2)
 
     lyPos = (typFormRect.Top + _
           (typFormRect.Bottom - typFormRect.Top) / 2) - _
          ((typRectMsg.Bottom - typRectMsg.Top) / 2)

'Position
      SetWindowPos wParam, 0, lxPos, lyPos, 0, 0, _
                   SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE

'Release the hook
      UnhookWindowsHookEx plMsgHook
   End If

CenterMsgCallBack = False

End Function