-
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...
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...
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
-
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.
-
I can't find it there.
Anyone?
------------------
Yonatan
Teenage Programmer
E-Mail: [email protected]
ICQ: 19552879
-
Sorry Yonatan...
Try this one:
http://www.planetsourcecode.com/vb/d...=1&blnFrm=true
I hope that helps.
Thanx.
-
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..
Code:
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..
Code:
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]
-
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.
-
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).]
