Visual Basic Programming Code Examples

Visual Basic > Forms Code Examples

Controlling the position of a MsgBox

Controlling the position of a MsgBox

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 align or position the window with the SetWindowPos API function and then finally release the CBT hook. See the "Test" routine for a demonstration.

'PLACE CODE IN A STANDARD MODULE

Option Explicit

Public Enum ePosMsgBox
    eTopLeft
    eTopRight
    eTopCentre
    eBottomLeft
    eBottomRight
    eBottomCentre
    eCentreScreen
    eCentreDialog
End Enum

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'Message API and constants
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal zlhHook 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

'Other APIs
Private Declare Function GetForegroundWindow Lib "user32" () As Long
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

Private zlhHook As Long
Private zePosition As ePosMsgBox


'Purpose   :    Displays a msgbox at a specified location on the screen
'Inputs    :    As per a standard MsgBox +
'               Position                An enumerated type which controls the screen position of the MsgBox
'Outputs   :    As per a standard Msgbox
'Notes     :

'Purpose   :    Displays a msgbox at a specified location on the screen
'Inputs    :    As per a standard MsgBox +
'               Position                An enumerated type which controls the screen position of the MsgBox
'Outputs   :    As per a standard Msgbox
'Notes     :    VB only, doesn't work in VBA

Function MsgboxEx(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title, Optional HelpFile, Optional Context, Optional Position As ePosMsgBox = eCentreScreen) As VbMsgBoxResult
    Dim lhInst As Long
    Dim lThread As Long

    'Set up the CBT hook
    lhInst = GetWindowLong(GetForegroundWindow, GWL_HINSTANCE)
    lThread = GetCurrentThreadId()
    zlhHook = SetWindowsHookEx(WH_CBT, AddressOf zWindowProc, lhInst, lThread)
    
    zePosition = Position
    
    'Display the message box
    MsgboxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function

'Call back used by MsgboxEx
Private Function zWindowProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tFormPos As RECT, tMsgBoxPos As RECT, tScreenWorkArea As RECT
    Dim lLeft As Long, lTop As Long
    Static sbRecursive As Boolean

    If lMsg = HCBT_ACTIVATE Then
        On Error Resume Next
        'A new dialog has been displayed
        tScreenWorkArea = ScreenWorkArea
        'Get the coordinates of the form and the message box so that
        'you can determine where the center of the form is located
        GetWindowRect GetForegroundWindow, tFormPos
        GetWindowRect wParam, tMsgBoxPos
        
        Select Case zePosition
        Case eCentreDialog
            lLeft = (tFormPos.Left + (tFormPos.Right - tFormPos.Left) / 2) - ((tMsgBoxPos.Right - tMsgBoxPos.Left) / 2)
            lTop = (tFormPos.Top + (tFormPos.Bottom - tFormPos.Top) / 2) - ((tMsgBoxPos.Bottom - tMsgBoxPos.Top) / 2)
        
        Case eCentreScreen
            lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
            lTop = ((tScreenWorkArea.Bottom - tScreenWorkArea.Top) - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)) / 2

        
        Case eTopLeft
            lLeft = tScreenWorkArea.Left
            lTop = tScreenWorkArea.Top
        
        Case eTopRight
            lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
            lTop = tScreenWorkArea.Top
        
        Case eTopCentre
            lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
            lTop = tScreenWorkArea.Top
        
        
        Case eBottomLeft
            lLeft = tScreenWorkArea.Left
            lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
        
        Case eBottomRight
            lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
            lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
        
        Case eBottomCentre
            lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
            lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
        
        End Select
        
        If lLeft < 0 And sbRecursive = False Then
            'Left handside of Msgbox is off-screen - reposition in middle of screen
            sbRecursive = True
            zePosition = eCentreScreen
            zWindowProc HCBT_ACTIVATE, wParam, lParam
            sbRecursive = False
            Exit Function
        End If

        'Position the msgbox
        SetWindowPos wParam, 0, lLeft, lTop, 10, 10, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
        
        'Release the CBT hook
        UnhookWindowsHookEx zlhHook
    End If
    zWindowProc = False

End Function


'Purpose   :    Returns the screen dimensions, not including the tastbar
'Inputs    :    N/A
'Outputs   :    A type which defines the extent of the screen work area.
'Notes     :

Function ScreenWorkArea() As RECT
    Dim tScreen As RECT
    Dim lRet As Long
    Const SPI_GETWORKAREA = 48
    
    lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, tScreen, 0)
    ScreenWorkArea = tScreen
End Function


'Demonstration routine
Sub Test()
    MsgboxEx "Hello BottomCentre", , , , , eBottomCentre
    MsgboxEx "Hello BottomLeft", , , , , eBottomLeft
    MsgboxEx "Hello BottomRight", , , , , eBottomRight
    MsgboxEx "Hello CentreDialog", , , , , eCentreDialog
    MsgboxEx "Hello CentreScreen", , , , , eCentreScreen
    MsgboxEx "Hello TopCentre", , , , , eTopCentre
    MsgboxEx "Hello TopLeft", , , , , eTopLeft
    MsgboxEx "Hello TopRight", , , , , eTopRight
End Sub