Форум на Исходниках.RU

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

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)

.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