Customize MessageBox Buttons

The built-in VB MsgBox function can be customized to change the text on the buttons by hooking into the MsgBox when it is called. This can be handy to add different options instead of the regular Yes/No/Cancel or Ignore/Retry/Abort buttons.

The following function provides an example of how to do this. This code should be placed into a module.

Option Explicit

' CONSTANTS
' MessageBoxEx uType constants
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_HELP As Long = &H4000
Private Const MB_OK As Long = &H0&
Private Const MB_OKCANCEL As Long = &H1&
Private Const MB_RETRYCANCEL As Long = &H5&
Private Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Private Const MB_YESNO As Long = &H4&
Private Const MB_YESNOCANCEL As Long = &H3&

Private Const MB_APPLMODAL As Long = &H0&
Private Const MB_SYSTEMMODAL As Long = &H1000&
Private Const MB_TASKMODAL As Long = &H2000&

Private Const MB_ICONASTERISK As Long = &H40&
Private Const MB_ICONEXCLAMATION As Long = &H30&
Private Const MB_ICONHAND As Long = &H10&
Private Const MB_ICONINFORMATION As Long = MB_ICONASTERISK
Private Const MB_ICONQUESTION As Long = &H20&
Private Const MB_ICONSTOP As Long = MB_ICONHAND

Private Const MB_DEFAULT_DESKTOP_ONLY As Long = &H20000
Private Const MB_DEFBUTTON1 As Long = &H0&
Private Const MB_DEFBUTTON2 As Long = &H100&
Private Const MB_DEFBUTTON3 As Long = &H200&
Private Const MB_DEFBUTTON4 As Long = &H300&

Private Const MB_DEFMASK As Long = &HF00&
Private Const MB_ICONMASK As Long = &HF0
Private Const MB_MISCMASK As Long = &HC000&
Private Const MB_MODEMASK As Long = &H3000&
Private Const MB_TYPEMASK As Long = &HF&

Private Const MB_NOFOCUS As Long = &H8000&
Private Const MB_RIGHT As Long = &H80000
Private Const MB_RTLREADING As Long = &H100000
Private Const MB_SERVICE_NOTIFICATION As Long = &H200000
Private Const MB_SETFOREGROUND As Long = &H10000
Private Const MB_TOPMOST As Long = &H40000

' Dialog text item constants
Private Const IDOK As Long = 1
Private Const IDCANCEL As Long = 2
Private Const IDABORT As Long = 3
Private Const IDRETRY As Long = 4
Private Const IDIGNORE As Long = 5
Private Const IDYES As Long = 6
Private Const IDNO As Long = 7
Private Const IDCLOSE As Long = 8
Private Const IDHELP As Long = 9
Private Const IDTRYAGAIN As Long = 10
Private Const IDCONTINUE As Long = 11
Private Const IDPROMPT As Long = 65535

' Other constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

' VARIABLES
Private lngHHook As Long                ' handle to msgbox hook
Private lngMsgType As Long
Private strButton1 As String
Private strButton2 As String
Private strButton3 As String
Private strButton4 As String
Private strMsgText As String
Private strMsgTitle As String

' API DECLARATIONS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" ( _
   ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
Private Declare Function MessageBoxEx Lib "user32" _
   Alias "MessageBoxExA" ( _
   ByVal hwnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal uType As Long, _
   ByVal wLanguageId As Long) 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 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 SetWindowText Lib "user32" _
   Alias "SetWindowTextA" ( _
   ByVal hwnd As Long, _
   ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
   ByVal hHook As Long) As Long

Public Function AdvMsgBox(lngHWindow As Long, _
    strMessage As String, strTitle As String, _
    lngIconOptions As Long, ParamArray ButtonText() As Variant) _
    As Long

    '
    ' Displays a message box with customizable button text
    '
    ' REQUIRES:
    '   lngHWindow      (LONG) Handle to window calling MsgBox.
    '                   Should be Me.hWnd.
    '   strMessage      (STRING) Message to appear in the MsgBox.
    '   strTitle        (STRING) Title of the MsgBox.
    '   lngIconOptions  (LONG) Any standard VB MsgBox icons or options
    '                   (e.g. vbExclamation, vbDefaultButton2).
    '
    ' OPTIONS:
    '   ButtonText()    Array of text to use as the title of each
    '                   button.  Buttons are created for each
    '                   ButtonText entry, up to three max.
    '
    ' RETURNS:
    '   1               First button was pushed
    '   2               Second button was pushed
    '   3               Third button was pushed
    '

    Dim lngHAppInstance As Long
    Dim lngHOwner As Long
    Dim lngHThread As Long
    Dim lngHThreadID As Long
    Dim lngResult As Long

    ' set text
    strMsgTitle = strTitle
    strMsgText = strMessage

    ' determine type of MessageBox to use
    Select Case UBound(ButtonText)
        Case 0 ' one button
            strButton1 = ButtonText(0)
            lngMsgType = vbOKOnly
        Case 1 ' two buttons
            strButton1 = ButtonText(0)
            strButton2 = ButtonText(1)
            lngMsgType = vbYesNo
        Case Else ' three buttons
            strButton1 = ButtonText(0)
            strButton2 = ButtonText(1)
            strButton3 = ButtonText(2)
            lngMsgType = vbYesNoCancel
    End Select

    lngMsgType = lngMsgType + lngIconOptions

    ' get handle to current application
    lngHOwner = GetDesktopWindow()

    ' create hook
    lngHAppInstance = GetWindowLong(lngHWindow, GWL_HINSTANCE)
    lngHThreadID = GetCurrentThreadId()
    lngHHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, _
        lngHAppInstance, lngHThreadID)

    ' create MsgBox
    lngResult = MessageBoxEx(lngHOwner, Space$(Len(strMsgText)), _
        Space$(Len(strMsgTitle)), lngMsgType, 0)

    ' return button pressed
    Select Case lngResult
        Case vbOK, vbYes
            lngResult = 1
        Case vbNo
            lngResult = 2
        Case vbCancel
            lngResult = 3
    End Select

    AdvMsgBox = lngResult

End Function

Private Function MsgBoxHookProc(ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim lngHMsgBox As Long

    If uMsg = HCBT_ACTIVATE Then
        ' wParam will be the handle to the messagebox
        lngHMsgBox = wParam

        ' set msgbox title
        SetWindowText lngHMsgBox, strMsgTitle

        ' set button text
        If (lngMsgType And vbYesNo) Then
            SetDlgItemText lngHMsgBox, IDYES, strButton1
            SetDlgItemText lngHMsgBox, IDNO, strButton2
        ElseIf (lngMsgType And vbYesNoCancel) Then
            SetDlgItemText lngHMsgBox, IDYES, strButton1
            SetDlgItemText lngHMsgBox, IDNO, strButton2
            SetDlgItemText lngHMsgBox, IDCANCEL, strButton3
        Else
            SetDlgItemText lngHMsgBox, IDOK, strButton1
        End If

        ' set main text
        SetDlgItemText lngHMsgBox, IDPROMPT, strMsgText

        ' release hook
        UnhookWindowsHookEx lngHHook
   End If

  ' return False to continue processing
   MsgBoxHookProc = False
End Function

Usage (this code would go in a Form module):

Dim lngResult as Long

lngResult = AdvMsgBox(Me.hWnd, _
    "Would you like to ignore this error?", "Error", _
    vbQuestion + vbDefaultButton3, "Ignore Once", _
    "Ignore All", "Cancel")

Author: ASAK
Created: Oct 3 2005 (last modified Nov 30 2005)
Categories: Visual Basic
TechByte #41

Warning: By visiting this site and/or by using any information contained herein, you agree to the Techbytes.ca terms of use.