Option Explicit

 

Global Const MY_MBOX_DEFAULT1 As Long = vbDefaultButton1

Global Const MY_MBOX_DEFAULT2 As Long = vbDefaultButton2

Global Const MY_MBOX_DEFAULT3 As Long = vbDefaultButton3

Global Const MY_MBOX_DEFAULT4 As Long = vbDefaultButton4

Global Const MY_MBOX_DEFAULT5 As Long = &H400

 

Private Declare Function SoftModalMessageBox Lib "user32.dll" (lpmb As MSGBOXDATA) As Long

Private Declare Function GetActiveWindow Lib "user32.dll" () As Long

Private Declare Function GetVersionExA Lib "kernel32.dll" (posv As OSVERSIONINFO) As Long

 

Private Type OSVERSIONINFO

    dwOSVersionInfoSize As Long

    dwMajorVersion As Long

    dwMinorVersion As Long

    dwBuildNumber As Long

    dwPlatformId As Long

    szCSDVersion As String * 128

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 Long

    dwContextHelpId As Long

    lpfnMsgBoxCallback As Long

    dwLanguageId As Long

End Type

 

Private Type MSGBOXDATA

    mbp As MSGBOXPARAMS

    pwndOwner As Long

    wLanguageId As Integer

    pidButton As Long

    ppszButtonText As Long

    cButtons As Long

    DefButton As Long

    CancelId As Long

    dwTimeout As Long

End Type

 

Public Function MyMsgBox(ByVal lpszPrompt As String, ByVal lpszTitle As String, ByVal dwStyle As VbMsgBoxStyle, _

    ByVal nCancelId As Long, ByVal hParentWnd As Long, ParamArray sButtons()) As VbMsgBoxResult

    On Error Resume Next

    Dim mbd As MSGBOXDATA, idb() As Long, pszTexts() As String, i As Long

    Dim osv As OSVERSIONINFO

    osv.dwOSVersionInfoSize = Len(osv)

    GetVersionExA osv

    If osv.dwMajorVersion < 5 Then MyMsgBox = -1: Exit Function

    

    If hParentWnd = 0 Then hParentWnd = GetActiveWindow()

    With mbd

    .cButtons = UBound(sButtons): If Err.Number = 9 Then Err.Clear Else: .cButtons = .cButtons + 1

    If .cButtons > 0 Then

        ReDim idb(0 To .cButtons - 1), pszTexts(0 To .cButtons - 1)

        For i = 0 To .cButtons - 1

        idb(i) = i + 1: pszTexts(i) = sButtons(i)

        Next

        .DefButton = (dwStyle \ &H100) And &HF

        If nCancelId >= 1 And nCancelId <= .cButtons Then .CancelId = nCancelId

        .pidButton = VarPtr(idb(0)): .ppszButtonText = VarPtr(pszTexts(0))

    Else

        .pidButton = 0: .ppszButtonText = 0: .cButtons = 0: .DefButton = 0: .CancelId = 0

    End If

    With mbd.mbp

    .cbSize = Len(mbd.mbp)

    .dwStyle = (dwStyle And &HFFF0&) Or 1

    .hInstance = App.hInstance

    .hwndOwner = hParentWnd

    .lpszCaption = StrConv(lpszTitle, vbUnicode)

    .lpszText = StrConv(lpszPrompt, vbUnicode)

    .lpszIcon = 0

    End With

    If osv.dwMajorVersion = 5 And osv.dwMinorVersion >= 1 Or osv.dwMajorVersion > 5 Then

        .dwTimeout = -1

    Else: .dwTimeout = 0

    End If

    End With

    MyMsgBox = SoftModalMessageBox(mbd)

End Function

Dim lButtonIndex As Long

lButtonIndex = MyMsgBox("Текст сообщения", "Заголовок", MY_MBOX_DEFAULT5 Or vbQuestion, 0, _

    0, "Button1", "Button2", "Button3", "Button4", "Button5")