Свой MessageBox

[ALXR]

Сразу скажу, что ЗНАЮ, что эта тема есть здесь, однако мой код составлялся по исходникам самой ф-ции SoftModalMessageBox, а уж потом я наткнулся на приведенную ссылку. Поскольку тот код непонятно почему порождал ошибку "Bad DLL calling convention", а мой (у меня же) работает вроде бы нормально, прошу проверить как он работает у вас:

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)
    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

Пользоваться так:

Call MyMsgBox("Текст сообщения","Заголовок",MY_MSGBOX_DEFAULT5 or vbQuestion, 0, _
 0, "Button1", "Button2", "Button3", "Button4", "Button5")

Соответственно, возвращаться будет число от 1 до 5.

Сообщение отредактировано: ALXR - 20.02.07, 03:10

[B.V.]

Работает он у нас, работает...

Цитата ALXR @ 20.02.07, 01:57

&h400 or vbQuestion

Ну и что же такое &h400?

[ALXR]

Что, с флагом WINDOWS_XP работает?

&H400 - кнопка по умолчанию (то бишь 4 + 1 = 5-ая), как и принято в стилях MBox'а: vbDefaultButton1, vbDefaultButton2 и т.п.

Сообщение отредактировано: ALXR - 20.02.07, 02:37

[B.V.]

Цитата ALXR @ 20.02.07, 02:36

Что, с флагом WINDOWS_XP работает?

У меня Win2k. Что будет с флагом WINDOWS_XP - посмотри в топике на VBS.

Цитата ALXR @ 20.02.07, 02:36

&H400 - кнопка по умолчанию (то бишь 4 + 1 = 5-ая), как и принято в стилях MBox'а: vbDefaultButton1, vbDefaultButton2 и т.п.

Я понял. Это был намек на то, что неплохо было бы создать константу MB_DEFBUTTON5 = &H400, а не давать ни о чем не говорящую цифру. Собственно, это же касается остальных "неизвестных" констант.

[ALXR]

Цитата B.V. @ 20.02.07, 02:40

Я понял. Это был намек на то, что неплохо было бы создать константу MB_DEFBUTTON5 = &H400, а не давать ни о чем не говорящую цифру. Собственно, это же касается остальных "неизвестных" констант.

Это пример вызова. Вызывать можно как удобно. Я использую только числа (именно в VB), поскольку все эти константы лениво очень расписывать. Остальные могут вызывать код как угодно...

PS: Собственно, можно в FAQ поправленный в плане версий вариант.

Сообщение отредактировано: ALXR - 20.02.07, 03:09

[B.V.]

Цитата ALXR @ 20.02.07, 03:09

все эти константы лениво очень расписывать

Ну... С ленью надо бороться, особенно в этом плане.

Вот что это такое?

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

Цитата ALXR @ 20.02.07, 01:57

MY_MSGBOX_DEFAULT5

Ты имел ввиду MY_MBOX_DEFAULT5?

[ALXR]

Цитата B.V. @ 20.02.07, 03:44

Ну... С ленью надо бороться, особенно в этом плане.

Вот что это такое?

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

Для того, чтобы бегло что-то набросать - не нужно. А чтобы не бегло - давно на vb чего-то серьезное писал, хотя там, однако, использовал их.

По поводу последнего вопроса: Выделяю нужную мне маску и устанавливаю младший бит. А что, это криминально? В коде нету констант. Совсем.