1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
| '---------------------------------------------------------------------------------------
' Module : modIconeDansMsgBox
' Auteur : fred65200 - Frédéric CHAPIN - http://www.developpez.net/forums/private.php?do=newpm&u=190475
' Date : 06/02/2009
' Description : Placer une icône perso dans la barre de titre d'un MsgBox
' Plus lourd qu'un UserForm, intéressant pour l'utilisation des APIs
'---------------------------------------------------------------------------------------
Option Explicit
'Constantes des MsgBox Windows
Private Const MB_OK = 0
Private Const MB_OKCANCEL = 1
Private Const MB_ABORTRETRYIGNORE = 2
Private Const MB_YESNOCANCEL = 3
Private Const MB_YESNO = 4
Private Const MB_RETRYCANCEL = 5
Private Const MB_ICONHAND = 16
Private Const MB_ICONQUESTION = 32
Private Const MB_ICONEXCLAMATION = 48
Private Const MB_ICONASTERISK = 64
Private Const MB_ICONINFORMATION = 64
Private Const MB_ICONSTOP = 16
Private Const MB_DEFBUTTON1 = 0
Private Const MB_DEFBUTTON2 = 256
Private Const MB_DEFBUTTON3 = 512
Private Const MB_APPLMODAL = 0
Private Const MB_SYSTEMMODAL = 4096
Private Const MB_TASKMODAL = 8192
'Valeurs renvoyées par les MsgBox Windows
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
Private Const IDPROMPT = &HFFFF&
Private Const HWND_DESKTOP = 0
Private X As Long
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function ExtractIconA Lib "shell32.dll" ( _
ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function SendMessageA Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam 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 UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Sub Test()
monMsgBox MB_OK, "monTitre", "Bla bla"
monMsgBox MB_YESNO + MB_ICONQUESTION, "monTitre", "Bla bla"
monMsgBox MB_OKCANCEL + MB_ICONEXCLAMATION, "monTitre", "Bla bla"
monMsgBox MB_OKCANCEL + MB_ICONHAND, "monTitre", "Bla bla"
monMsgBox MB_ABORTRETRYIGNORE + MB_ICONASTERISK + MB_DEFBUTTON2, "monTitre", "Bouton 2 par défaut"
End Sub
Function monMsgBox( _
boutons As Long, _
titre As String, _
texte As String) As Long
'Interception du Hook
With MHP
.hwndOwner = HWND_DESKTOP
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
GetWindowLong(HWND_DESKTOP, GWL_HINSTANCE), _
GetCurrentThreadId())
End With
'Appel de la fonction API
monMsgBox = MessageBox(HWND_DESKTOP, _
texte, _
titre, _
boutons)
End Function
Function MsgBoxHookProc( _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'Le MsgBox va bientôt s'afficher
If uMsg = HCBT_ACTIVATE Then
'Bouton Ok personnalisé
SetDlgItemText wParam, IDOK, "C'est b&on"
SetDlgItemText wParam, IDCANCEL, "&Annule moi ça"
SetDlgItemText wParam, IDYES, "&Ouuuui!"
SetDlgItemText wParam, IDNO, "&Nooooon!"
'icône Word pour le sujet
X = ExtractIconA(0, Application.Path & Application.PathSeparator & "Winword.exe", 0)
SendMessageA wParam, &H80, False, X
'«Unhook»
UnhookWindowsHookEx MHP.hHook
End If
MsgBoxHookProc = False
End Function |
Partager