Кастомные подписи кнопок в месседжбоксе

[tyomitch]

Код: Выделить всё

Option Explicit

Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As Long
    hInstance As Long
    lpszText As Long
    lpszCaption As Long
    dwStyle As Long
    lpszIcon As Long
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type

Private Type MSGBOXDATA
    params As MSGBOXPARAMS
    pwndOwner As Long
    wLanguageId As Integer
    pidButton As Long '                 // Array of button IDs
    ppszButtonText As Long '            // Array of button text strings
    cButtons As Long
    DefButton As Long
    CancelId As Long
    Timeout As Long
End Type

Private Declare Function SoftModalMessageBox Lib "user32" (pMsgBoxParams As MSGBOXDATA) As Long

Sub Main()
Dim mbd As MSGBOXDATA, Buttons(3) As Long, Captions(3) As String
    Captions(0) = "Нафиг"
    Buttons(0) = vbAbort
    Captions(1) = "Нефиг"
    Buttons(1) = vbRetry
    Captions(2) = "Пофиг"
    Buttons(2) = vbIgnore
    Captions(3) = "Отмена"
    Buttons(3) = vbCancel
With mbd
    With .params
        .cbSize = LenB(mbd.params)
        .lpszText = StrPtr(Replace("Чтобы сделать месседжбокс с собственными подписями\nкнопок, совсем не обязательно рисовать форму самому:\nдля этого идеально подходит малодокументированная\nфункция SoftModalMessageBox.", "\n", vbCrLf))
        .lpszCaption = StrPtr("Круто, да?")
        .dwStyle = vbQuestion & vbOKCancel
    End With
    .DefButton = 2
    .CancelId = vbCancel
    .cButtons = 4
    .pidButton = VarPtr(Buttons(0))
    .ppszButtonText = VarPtr(Captions(0))
    .Timeout = -1
End With
Debug.Print SoftModalMessageBox(mbd)
End Sub


[keks-n]

Эээээ... А почему

Инструкция по адресу "0x77e48e2c" обратилась к памяти по адресу "0xffffffff". Память не может быть "read"

после нажатия одной из кнопок месаджбокса? (Дебагер грит, что 0x77e48e2c - в USER32.DLL)

[BV]

Аналогично.

---------------------------
Круто, да?: vb6.exe - Application Error
---------------------------
The instruction at "0x77e48e2c" referenced memory at "0xffffffff". The memory could not be "read".


Click on OK to terminate the program
Click on CANCEL to debug the program
---------------------------
OK Cancel
---------------------------

---------------------------
Microsoft Visual C++
---------------------------
Unhandled exception in VB6.EXE (USER32.DLL): 0xC0000005: Access Violation.
---------------------------
OK
---------------------------

Windows 2000 SP4 En

[tyomitch]

Приношу свои извинения: в конец структуры MSGBOXDATA нужно добавить поле Unknown As Long

[Kovu]

Хы, а у меня и без поля нормально работало

[BV]

в конец структуры MSGBOXDATA нужно добавить поле Unknown As Long

То же самое.

[tyomitch]

Хы, а у меня и без поля нормально работало

А скомпилированное пробовал?

в конец структуры MSGBOXDATA нужно добавить поле Unknown As Long

То же самое.

В Win2000 нужно убрать строку .Timeout = -1 (функция MessageBoxTimeout появилась только в WinXP)

Дополнительный бонус для обладателей WinXP: если установить .cButtons в 0 и Timeout в конечное значение, получится автоубирающееся окно "пассивного предупреждения". Круто, да?

[tyomitch]

А вот ещё одна фишка (проверять нужно из-под IDE)

Замените ".dwStyle = vbQuestion & vbOKCancel" на

Код: Выделить всё

        .dwStyle = 129
        .lpszIcon = 1256
        .hInstance = App.hInstance


[Kovu]

tyomitch
А какой стиль надо поставить чтобы иконка грузилась не из ресурсов, а допустим через LoadPicture ?

[tyomitch]

Низя; можно только из ресурсов. (См. доку по MessageBoxIndirect, структура MSGBOXPARAMS объявлена там.)

[Lumen]

tyomitch
Супер!!! А я помню, когда делал подобный мессаджбокс, приходилось ставить хук на появление окна, а затем вручную перебирать все дочерние окна этого окна и выставлять им соотвествующий текст (если кнопка) или картинку (если Static).

Спасибо!!!

[keks-n]

Kovu
Ставишь перехват на LoadIcon(или LoadIconEx, посмотри в дебаггере), и возвращаещь Picture.handle. По идее должно заработать.

[tyomitch]

Я бы просто по нулевому таймеру подменил иконку в статике. И никакие перехватчики не нужны, пять строк на весь код. Плюс совместимость с Win9x.

[keks-n]

Так давай код А то мы, неграмотные, нагородим тут всякого...

[tyomitch]

Код: Выделить всё

Option Explicit

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 KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const STM_SETICON = &H170

Dim hTimer As Long, hIcon As StdPicture

Sub Main()
    Set hIcon = LoadPicture("c:\earth.ico", vbLPLarge, vbLPColor)
    hTimer = SetTimer(0, 0, 0, AddressOf TimerProc)
    MsgBox "Неужели правда так сложно сделать это самим?", vbInformation, "пять строчек кода"
End Sub

Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    KillTimer 0, hTimer
    SendDlgItemMessage GetForegroundWindow, 20, STM_SETICON, hIcon, 0
End Sub


[keks-n]

Мне проще было сделать перехват

[tyomitch]

Когда в руках молоток, всё вокруг кажется гвоздями (с)

[Nicky]

Код: Выделить всё

Expression      Value      Type
-------------------------------
vbOKCancel       1         Long
vbQuestion      32         Long
dwStyle                    Long

dwStyle = vbQuestion & vbOKCancel '( = 321)


[tyomitch]

Код: Выделить всё

Expression      Value      Type
-------------------------------
vbOKCancel       1         Long
vbQuestion      32         Long
dwStyle                    Long

dwStyle = vbQuestion & vbOKCancel '( = 321)


Таки-да, бага. Но это поле всё равно функцией игнорируется

[Nicky]

Таки-да, бага. Но это поле всё равно функцией игнорируется

Да?
Тогда почему при .dwStyle = vbQuestion & vbOKOnly что ни нажмешь, печатает 1?

И еще: как сделать 1 кнопку?, 2? 0?
[EDIT]:1 кнопку нашел, 2 нашел (макс кнопок 5). При .cButtons = 0 зависла
[EDIT]: эээ, не зависла, а ожидала заданное время (бесконечность Однако работает...

[tyomitch]

Таки-да, бага. Но это поле всё равно функцией игнорируется

Да?
Тогда почему при .dwStyle = vbQuestion & vbOKOnly что ни нажмешь, печатает 1?

Это фича. Если младшие 4 бита стиля нулевые, возвращается всегда 1, иначе ID нажатой кнопки.

[Nicky]

Как показывать стандартные иконки (Question, Information, Critical, без иконки)?

[tyomitch]

стандартно: 4--6 биты стиля
(таки да, он не совсем игнорируется)

[lister]

Сорри, что влезаю в старую тему...

Тёмыч, а у тебя нет примерчика по изменению MessageBox ?

Вот хочу добавить в него чекбокс "Не показывать более данное сообщение"

P.S.
Можно, конечно, свое окно нарисовать... Но ведь мы простых путей не ищем

[Nicky]

Точно было на форуме

[tyomitch]

http://bbs.vbstreets.ru/viewtopic.php?t=14118

[lister]

АФИГЕТЬ!!!
Я в восторге!!!