MsgBox BackColor + ForeColor

[Yonatan]

Why can't I choose the colors of my MsgBox?
I think my code is OK, the only problem is, the WM_CTLCOLORMSGBOX message never reaches my form!
I've also tried the MessageBox API, in suspicion that the MsgBox VB function might be some altered version, but I get the same result.
Here's my code:

Module Code...

Option Explicit


Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32" (ByVal oleColor As OLE_COLOR, ByVal hPalette As Long, pColorRef As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long


Private Const GWL_WNDPROC = (-4)


Private Const WM_CTLCOLORMSGBOX = &H132
Private Const WM_DESTROY = &H2


Private Const CLR_INVALID = &HFFFFFFFF


Private lpfnPreviousWindowProcedure As Long
Private m_lhWnd As Long
Private m_lhBrush As Long


Public MsgBoxBackColor As OLE_COLOR
Public MsgBoxForeColor As OLE_COLOR


Private Function TranslateColor(ByVal oleColor As OLE_COLOR, Optional ByVal hPalette As Long = 0) As Long
    If OleTranslateColor(oleColor, hPalette, TranslateColor) <> 0 Then TranslateColor = CLR_INVALID
End Function


Private Function WindowProcedure(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lBkColor As Long, lTextColor As Long
    If Msg = WM_CTLCOLORMSGBOX Then
        lBkColor = TranslateColor(MsgBoxBackColor)
        lTextColor = TranslateColor(MsgBoxForeColor)
        If lBkColor = CLR_INVALID Then lBkColor = TranslateColor(vbButtonFace)
        If lTextColor = CLR_INVALID Then lTextColor = TranslateColor(vbButtonText)
        Call DeleteObject(m_lhBrush)
        m_lhBrush = CreateSolidBrush(lBkColor)
        WindowProcedure = m_lhBrush
        Call SetBkColor(wParam, lBkColor)
        Call SetTextColor(wParam, lTextColor)
        Exit Function
    End If
    If Msg = WM_DESTROY Then Call DeleteObject(m_lhBrush)
    WindowProcedure = CallWindowProc(lpfnPreviousWindowProcedure, hWnd, Msg, wParam, lParam)
End Function


Public Sub Hook(ByVal lhWnd As Long)
    If (m_lhWnd <> 0) Or (lhWnd = 0) Then Exit Sub
    m_lhWnd = lhWnd
    MsgBoxBackColor = vbButtonFace
    MsgBoxForeColor = vbButtonText
    lpfnPreviousWindowProcedure = SetWindowLong(m_lhWnd, GWL_WNDPROC, AddressOf WindowProcedure)
End Sub


Public Sub Unhook()
    Call SetWindowLong(m_lhWnd, GWL_WNDPROC, lpfnPreviousWindowProcedure)
    m_lhWnd = 0
End Sub

Form Code...

Option Explicit


Private Sub Form_Load()
    Call Hook(hWnd)
    MsgBoxBackColor = vbBlue
    MsgBoxForeColor = vbYellow
    Call MsgBox("Hello, world!") ' Should be yellow text on blue background
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call Unhook
End Sub

Help...?

------------------
Yonatan
Teenage Programmer
E-Mail: [email protected]
ICQ: 19552879

[Lyla]

Hi Yonatan..
Check this one:
http://216.46.226.13/vb/default.asp

Go to newest code: Page # 1 , I think post # 15.

Good Luck.

[Yonatan]

I can't find it there.

Anyone?

------------------
Yonatan
Teenage Programmer
E-Mail: [email protected]
ICQ: 19552879

[Lyla]

Sorry Yonatan...
Try this one:
http://www.planetsourcecode.com/vb/d...=1&blnFrm=true

I hope that helps.

Thanx.

[Aaron Young]

The WM_CTLCOLORMSGBOX Message doesn't get sent to the Form, or even the Thread, instead the Messagebox Hwnd Revieces the WM_CTLCOLORDLG Message. I finally figured out how to get to it and here's how..

In a Module..

Public Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type

Public Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WH_CALLWNDPROC = 4
Public Const WM_CREATE = &H1
Public Const WM_CTLCOLORBTN = &H135
Public Const WM_CTLCOLORDLG = &H136
Public Const WM_CTLCOLORSTATIC = &H138
Public Const WM_DESTROY = &H2

Public lPrevWnd As Long
Public lHook As Long
Public MSGBOX_BACKCOLOR As Long
Public MSGBOX_FORECOLOR As Long

Public Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tLB As LOGBRUSH
    Select Case Msg
    Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC, WM_CTLCOLORBTN
        'Set the DC Back Color
        Call SetTextColor(wParam, MSGBOX_FORECOLOR)
        Call SetBkColor(wParam, MSGBOX_BACKCOLOR)
        'Create a Solid Brush using that Color
        tLB.lbColor = MSGBOX_BACKCOLOR
        'Return the Handle to the Brush to Paint the Messagebox
        SubMsgBox = CreateBrushIndirect(tLB)
        Exit Function
    Case WM_DESTROY
        'Remove the Messagebox Subclassing
        Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
    End Select
    SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
End Function

Public Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCWP As CWPSTRUCT
    Dim sClass As String
    'This is where you need to Hook the Messagebox
    CopyMemory tCWP, ByVal lParam, Len(tCWP)
    If tCWP.message = WM_CREATE Then
        sClass = Space(255)
        sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255))
        If sClass = "#32770" Then
            'Subclass the Messagebox as it's created
            lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
        End If
    End If
    HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam)
End Function

In a Form with a Command Button..

Private Sub Command1_Click()
    MsgBox "This is a Modified Messagebox!!"
End Sub

Private Sub Form_Load()
    'Specify the MsgBox ForeColor
    MSGBOX_FORECOLOR = vbWhite
    'Specify the MsgBox BackColor
    MSGBOX_BACKCOLOR = RGB(200, 200, 255)
    'Monitor All Messages to this Thread.
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Remove the Hook
    Call UnhookWindowsHookEx(lHook)
End Sub

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]

[Bob Baddeley]

I don't mean to bother you, but why bother trying to do all this? Why don't you just make a new form that acts like a message box? It'd be a lot easier.

[Aaron Young]

You could argue it would take as much or, more likely, more time and resources (Images, Buttons, etc..)
to make a custom messagebox using a Standard Form that would mimic all the Msgbox functionality.

I guess it comes down to a matter of preference.

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]


[This message has been edited by Aaron Young (edited 11-12-1999).]