##CocoLiu 一年前的个人编写,希望大家喜欢。##
效果图如上:^-^ :)
Option Explicit
'*************************************************************
'*模块:mMsgBoxEx
'*功能:把对话框的字体改变颜色,背景改变图片。
'*调用:MsgBoxEx("改变背景对话框!" , vbOKOnly , "提示", , , vbCyan)
'*************************************************************
Private Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hWnd As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
'透明处理
Public Const TRANSPARENT = 1
Private Const WH_CALLWNDPROC = 4
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLORBTN = &H135
Private Const WM_DESTROY = &H2
Private Const WM_SETTEXT = &HC
Private Const WM_CREATE = &H1
' System Color Constants
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNTEXT = 18
' Windows Messages
Private Const WM_CTLCOLORSTATIC = &H138
Private Const WM_CTLCOLORDLG = &H136
Private lHook As Long
Private lPrevWnd As Long
Private lForecolor As Long
Public Function SubMsgBox(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim sText As String
Select Case Msg
'对话框颜色和标签颜色Message
Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC
Debug.Print wParam & ":Wparam"
'Set Font Back 透明 和改变颜色。
If Msg = WM_CTLCOLORSTATIC Then
Call SetBkMode(wParam, TRANSPARENT)
End If
Call SetTextColor(wParam, lForecolor)
'Set BackGround Picture。
SubMsgBox = CreatePatternBrush(LoadResPicture(101, 0).Handle)
'LoadResPicture(101, 0).Handle 是资源文件中ID为101的图片。
Exit Function
Case WM_DESTROY
'Remove the MsgBox Subclassing
Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWnd)
End Select
SubMsgBox = CallWindowProc(lPrevWnd, hWnd, Msg, wParam, ByVal lParam)
End Function
Private 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