[blue]Option Explicit
Const FW_NORMAL = 400
Const FW_BOLD = 700
Private Const WM_SETFONT = &H30
' Necessary constants for hooking
Private Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
' Working variables that require global scope in hooking module
Private hHook As Long
Private myFont As IFont
' The API declarations we need
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, lpsz2 As Any) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
' Wrapper for the normal MsgBox function
Public Sub myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, fSize As Integer, fBold As Boolean, fItalic As Boolean, fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long)
Set myFont = New StdFont
myFont.Size = fSize ' We can play around with the font to our heart's content here, all in a VB-friendly way
myFont.Bold = fBold
myFont.Italic = fItalic
myFont.Underline = fULine
myFont.Name = fFaceName
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
MsgBox Prompt, Buttons, Title, HelpFile, Context 'code hangs here
End Sub
Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hwndMsgBox As Long
If lMsg = HCBT_ACTIVATE Then
hwndMsgBox = FindWindowEx(wParam, 0&, "Static", ByVal "")
hwndMsgBox = FindWindowEx(wParam, hwndMsgBox, "Static", ByVal 0&) ' get the msgbox window, which has the obscure name of "#32770" as opposed to something more normal like "Edit"
If hwndMsgBox Then SendMessage hwndMsgBox, WM_SETFONT, myFont.hFont, True ' Do your stuff here to modify the window
UnhookWindowsHookEx hHook ' Immediately unhook
End If
CBTProc = 0 ' allow operation to continue
End Function[/blue]