MsgBox Positioning

[AlexanderBB]

Hi, I know I could use to a Form to achieve this, but maybe there is a way
to say where a MsgBox will appear ?
Currently it's center of screen, but I would like to center it instead over Form 1.
Possible ? Thanks.

[Elroy]

You'll have to use the callback. I've never had a desire to do it, but I'm certain it can be done. Worst case would be to grab the hWnd, subclass it, and reposition it on the appropriate message. I've got code to catch the callback. My MsgBoxEx function does a timer, custom button captions, and a few other things. I'll post it in my next post to the thread.

[Elroy]

Placed somewhere in a BAS module:

Option Explicit
'
Public Enum MsgIconEnum
    mbCritical = 16
    mbExclamation = 48
    mbInformation = 64
    mbQuestion = 32
End Enum
#If False Then ' Intellisense fix.
    Public mbCritical, mbExclamation, mbInformation, mbQuestion
#End If
'
Public Enum MsgStyleEnum
    mbYesNoCancel = &H3&
    mbYesNo = &H4&
    mbRetryCancel = &H5&
    mbOKCancel = &H1&
    mbOkOnly = &H0&
    mbAbortRetryIgnore = &H2&
End Enum
#If False Then ' Intellisense fix.
    Public mbYesNoCancel, mbYesNo, mbRetryCancel, mbOKCancel, mbOkOnly, mbAbortRetryIgnore
#End If
'
Private Type MSGBOX_HOOK_PARAMS
   hWndOwner   As Long
   hHook       As Long
End Type
Private Type MSGBOXPARAMS
    cbSize As Long
    hWndOwner As Long
    hInstance As Long
    lpszText As String
    lpszCaption As String
    dwStyle As Long
    lpszIcon As String
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type
Public Type RECT
    Left   As Long
    Top    As Long
    Right  As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type
'
Dim mbStyle As MsgStyleEnum
Dim mbIcon As MsgIconEnum
Dim msTitle As String
'
Dim TimerID As Long
Dim TimedOut As Boolean
'
Dim msBut1 As String
Dim msBut2 As String
Dim msBut3 As String
Dim msBut4 As String
'
Dim mhWndMsgBox As Long
Dim MSGHOOK As MSGBOX_HOOK_PARAMS
'
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetDesktopWindow Lib "user32" () 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 SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'


Public Function MsgBoxEx(hWndOwner As Long, Style As MsgStyleEnum, Title As String, message As String, Optional Icon As MsgIconEnum, _
                         Optional ButA As String, Optional ButB As String, Optional ButC As String, _
                         Optional MilliSeconds As Long) As String
    ' This function sets your custom parameters and returns which button was pressed as a string.
    ' If a message box is a style with a "Cancel" button, the "X" on the form will be enabled.
    ' If the "X" of the form is pressed, the text of the last button (corresponding to cancel) will be returned.
    ' On an mbOkOnly textbox, the "X" will return the OK button.
    ' MilliSeconds is a timer.  If it times out, the function returns "TimedOut" string.  Can't be used with (mbAbortRetryIgnore and mbYesNo styles).
    Dim mReturn As Long
    Dim hInstance As Long
    Dim hThreadId As Long
    '
    Const WH_CBT = 5
    Const GWL_HINSTANCE = -6
    '
    Const IDOK = 1
    Const IDCANCEL = 2
    Const IDAbort = 3
    Const IDRETRY = 4
    Const IDIGNORE = 5
    Const IDYES = 6
    Const IDNO = 7
    '
    mbStyle = Style
    mbIcon = Icon
    msTitle = Title
    'mPrompt = Message
    msBut1 = ButA
    msBut2 = ButB
    msBut3 = ButC
    '
    hInstance = App.hInstance
    hThreadId = GetCurrentThreadId()
    MSGHOOK.hWndOwner = GetDesktopWindow()
    MSGHOOK.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
    '
    ' No default value is defined for mbAbortRetryIgnore and mbYesNo message box styles.
    ' In other words, the close (x) button is disabled, and the timer can NOT close the box.
    ' Therefore, timer can't be used.
    If Style = mbAbortRetryIgnore Or Style = mbYesNo Then MilliSeconds = 0
    If MilliSeconds <> 0 Then TimerID = SetTimer(0&, 0&, MilliSeconds, AddressOf MsgBoxTimerProc)
    '
    mReturn = MessageBox(hWndOwner, message, Space$(120), mbStyle Or mbIcon)
    '
    If TimerID <> 0 Then
        KillTimer 0&, TimerID
        TimerID = 0
    End If
    '
    If TimedOut Then
        MsgBoxEx = "TimedOut"
        TimedOut = False
    Else
        Select Case mReturn
        Case IDOK:            MsgBoxEx = msBut1
        Case IDAbort:         MsgBoxEx = msBut1
        Case IDRETRY:         MsgBoxEx = msBut2
        Case IDIGNORE:        MsgBoxEx = msBut3
        Case IDYES:           MsgBoxEx = msBut1
        Case IDNO:            MsgBoxEx = msBut2
        Case IDCANCEL ' This may be the second or third button.
            If (mbStyle And 7) = mbYesNoCancel Then
                MsgBoxEx = msBut3
            Else
                MsgBoxEx = msBut2
            End If
        End Select
    End If
End Function

Public Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' This function catches the messagebox before it opens
    ' and changes the text of the buttons - then removes the hook.
    Dim r As RECT
    '
    Const IDPROMPT = &HFFFF&
    Const IDOK = 1
    Const IDCANCEL = 2
    Const IDAbort = 3
    Const IDRETRY = 4
    Const IDIGNORE = 5
    Const IDYES = 6
    Const IDNO = 7
    Const HCBT_ACTIVATE = 5
    '
    If uMsg = HCBT_ACTIVATE Then
        mhWndMsgBox = wParam
        '
        SetWindowText wParam, msTitle
        'SetDlgItemText wParam, IDPROMPT, mPrompt
        Select Case (mbStyle And 7) ' Filter out other bits.
        Case vbAbortRetryIgnore
            SetDlgItemText wParam, IDAbort, msBut1
            SetDlgItemText wParam, IDRETRY, msBut2
            SetDlgItemText wParam, IDIGNORE, msBut3
        Case vbYesNoCancel
            SetDlgItemText wParam, IDYES, msBut1
            SetDlgItemText wParam, IDNO, msBut2
            SetDlgItemText wParam, IDCANCEL, msBut3
        Case vbOKOnly
            SetDlgItemText wParam, IDOK, msBut1
        Case vbRetryCancel
            SetDlgItemText wParam, IDRETRY, msBut1
            SetDlgItemText wParam, IDCANCEL, msBut2
        Case vbYesNo
            SetDlgItemText wParam, IDYES, msBut1
            SetDlgItemText wParam, IDNO, msBut2
        Case vbOKCancel
            SetDlgItemText wParam, IDOK, msBut1
            SetDlgItemText wParam, IDCANCEL, msBut2
        End Select
        UnhookWindowsHookEx MSGHOOK.hHook
    End If
    MsgBoxHookProc = False
End Function

Public Function MsgBoxTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long
    Const WM_CLOSE = &H10
    If IsWindow(mhWndMsgBox) Then
        PostMessage mhWndMsgBox, WM_CLOSE, 0, ByVal 0&
        TimedOut = True
    End If
End Function

There you go. You should be able to tweak inside of that "If uMsg = HCBT_ACTIVATE Then" block, using the mhWndMsgBox, and put it where you want it.

Just as a quick example, here's how to call the thing (I just threw it into Form1):

Option Explicit

Private Sub Form_Click()
    MsgBoxEx Me.hWnd, mbOkOnly, "A Message Box", "Tell me when you're ready. You have 4 seconds.", mbQuestion, "Ready?", , , 4000
End Sub

Good Luck,
Elroy

EDIT1: Tip: Read about SetWindowPos to position it. Look at MSDN for a description of the arguments, and I'm sure it's used many times in code postings on these forums. Here's the declaration for it:

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

EDIT2: If I were doing it, I'd just make two more Optional arguments on the end of the MsgBoxEx declaration, maybe Optional xPosPels As Long = -1, Optional yPosPels As Long = -1. And maybe use -1 to indicate that it's centered. And, if it's not, set them to module-level variables, and then, in the callback, move it.

[fafalone]

The TaskDialog is the modern replacement for the message box. If you switched to using that, all you have to do is specify the owner by hWnd (Form1.hWnd) and use the TDF_POSITION_RELATIVE_TO_WINDOW flag. I've got a class module, cTaskDialog, that fully implements the API and adds lots of new features; with that class a basic 'Hello' centered on your form is done like this:

Dim cTD As cTaskDialog
Set cTD = New cTaskDialog
cTD.Flags = TDF_POSITION_RELATIVE_TO_WINDOW
cTD.Content = "Hello!"
cTD.CommonButtons = TDCBF_OK_BUTTON
cTD.ParenthWnd = Me.hWnd
cTD.ShowDialog

but if you have no need of anything fancy, here's a complete, copy-pastable bas module for making very simple (i.e. like MsgBox) dialogs:

Option Explicit
Private Declare Function TaskDialogIndirect Lib "comctl32.dll" (pTaskConfig As TASKDIALOGCONFIG, _
                                                                pnButton As Long, _
                                                                pnRadioButton As Long, _
                                                                pfVerificationFlagChecked As Long) As Long

Private Type TASKDIALOGCONFIG
    cbSize As Long
    hwndParent As Long
    hInstance As Long
    dwFlags As TASKDIALOG_FLAGS
    dwCommonButtons As TDBUTTONS
    pszWindowTitle As Long
    'hMainIcon As Long
    pszMainIcon As TDICONS
    pszMainInstruction As Long
    pszContent As Long
    cButtons As Long
    pButtons As Long
    nDefaultButton As Long
    cRadioButtons As Long
    pRadioButtons As Long
    nDefaultRadioButton As Long
    pszVerificationText As Long
    pszExpandedInformation As Long
    pszExpandedControlText As Long
    pszCollapsedControlText As Long
    pszFooterIcon As TDICONS
    'hFooterIcon As Long
    pszFooter As Long
    pfCallback As Long
    lpCallbackData As Long
    CXWidth As Long
End Type
Public Enum TDICONS
    TD_WARNING_ICON = -1 'exclamation point in a yellow 'yield' triangle (same image as IDI_EXCLAMATION)
    TD_ERROR_ICON = -2 'round red circle containg 'X' (same as IDI_HAND)
    TD_INFORMATION_ICON = -3 'round blue circle containing 'i' (same image as IDI_ASTERISK)
    TD_SHIELD_ICON = -4 'Vista's security shield
    IDI_APPLICATION = 32512& 'miniature picture of an application window
    IDI_QUESTION = 32514& 'round blue circle containing '?'

    TD_SHIELD_GRADIENT_ICON = -5 'same image as TD_SHIELD_ICON; main message text on gradient blue background
    TD_SHIELD_WARNING_ICON = -6 'exclamation point in yellow Shield shape; main message text on gradient orange background
    TD_SHIELD_ERROR_ICON = -7 'X contained within Shield shape; main message text on gradient red background
    TD_SHIELD_OK_ICON = -8 'Shield shape containing green checkmark; main message text on gradient green background
    TD_SHIELD_GRAY_ICON = -9 'same image as TD_SHIELD_ICON; main message text on medium gray background
    TD_NO_ICON = 0 'no icon; text on white background
End Enum

'taskdialog common button flags
Public Enum TDBUTTONS
    TDCBF_OK_BUTTON = &H1&      'return value 1 (IDOK)
    TDCBF_YES_BUTTON = &H2&     'return value 6 (IDYES)
    TDCBF_NO_BUTTON = &H4&      'return value 7 (IDNO)
    TDCBF_CANCEL_BUTTON = &H8&  'return value 2 (IDCANCEL)
    TDCBF_RETRY_BUTTON = &H10&   'return value 4 (IDRETRY)
    TDCBF_CLOSE_BUTTON = &H20&   'return value 8 (IDCLOSE)
End Enum
Public Enum TDRESULT
    TD_OK = 1
    TD_YES = 6
    TD_NO = 7
    TD_CANCEL = 2
    TD_RETRY = 4
    TD_CLOSE = 8
End Enum
Public Enum TASKDIALOG_FLAGS
    TDF_ENABLE_HYPERLINKS = &H1
    TDF_USE_HICON_MAIN = &H2
    TDF_USE_HICON_FOOTER = &H4
    TDF_ALLOW_DIALOG_CANCELLATION = &H8
    TDF_USE_COMMAND_LINKS = &H10
    TDF_USE_COMMAND_LINKS_NO_ICON = &H20
    TDF_EXPAND_FOOTER_AREA = &H40
    TDF_EXPANDED_BY_DEFAULT = &H80
    TDF_VERIFICATION_FLAG_CHECKED = &H100
    TDF_SHOW_PROGRESS_BAR = &H200
    TDF_SHOW_MARQUEE_PROGRESS_BAR = &H400
    TDF_CALLBACK_TIMER = &H800
    TDF_POSITION_RELATIVE_TO_WINDOW = &H1000
    TDF_RTL_LAYOUT = &H2000
    TDF_NO_DEFAULT_RADIO_BUTTON = &H4000
    TDF_CAN_BE_MINIMIZED = &H8000&
    TDF_SIZE_TO_CONTENTS = &H1000000
End Enum


Public Function SimpleTaskDlg(sMessage As String, Optional dwBtn As TDBUTTONS = TDCBF_OK_BUTTON, Optional sTitle As String, Optional nIcon As TDICONS, Optional dwFlags As TASKDIALOG_FLAGS, Optional hWndOwner As Long) As TDRESULT
Dim tTDI As TASKDIALOGCONFIG
Dim stt As String
Dim pBtn As Long, pVf As Long, pRd As Long

If sTitle = "" Then
    stt = App.Title
Else
    stt = sTitle
End If
With tTDI
    .cbSize = Len(tTDI)
    .dwCommonButtons = dwBtn
    .dwFlags = dwFlags
    .pszMainIcon = tdMakeIntResource(nIcon)
    .pszContent = StrPtr(sMessage)
    .pszWindowTitle = StrPtr(stt)
    .hwndParent = hWndOwner
End With
Call TaskDialogIndirect(tTDI, pBtn, pRd, pVf)
SimpleTaskDlg= pBtn
End Function

Private Function tdMakeIntResource(ByVal dwVal As Long) As Long
   tdMakeIntResource = &HFFFF& And dwVal
End Function

And called like:

Private Sub Command1_Click()
Dim lResult As TDRESULT

lResult = SimpleTaskDlg("Hi there!", TDCBF_OK_BUTTON, "Clever title", TD_INFORMATION_ICON, TDF_POSITION_RELATIVE_TO_WINDOW, Me.hWnd)

Debug.Print "r=" & lResult

End Sub

You can combine the buttons in any way just like a MsgBox... no limit to how many (well, 1 of each, then custom buttons are possible but not implemented here), or to what goes with what.. you can even do TDCBF_OK_BUTTON Or TDCBF_NO_BUTTON Or TDCBF_RETRY_BUTTON. If you leave the icon argument out, no icon appears. -5 through -9 add a colored gradient at the top. There's mountains of possibilities with this API; but the code above is just meant to replicate the MsgBox functionality plus centering--- the first 3 arguments are the same, and the returns match up with VbMsgBoxResults.. so super easy to swap out. See the class module if you're curious about what is possible.

and ta-da!


Edit: Not to start making it too complex, but note that you might want to add a string for .pszMainInstruction then you can have the big text/small text;


NOTE: This requires your app (and the IDE if ran from there) be manifested for Common Controls 6.0. See LaVolpe's project if unfamiliar.