2个回答
展开全部
复制来的没测试过你自己试试吧
弄张纯色图片当背景
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
'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
Public
Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As
VbMsgBoxStyle, Optional ByVal Title As String, Optional ByVal HelpFile As
String, Optional ByVal Context As Long, Optional ByVal ForeColor As
ColorConstants = -1) As Long
Dim lReturn As
Long
lHook = SetWindowsHookEx(WH_CALLWNDPROC,
AddressOf HookWindow, App.hInstance,
App.ThreadID)
'Set the
Defaults
If Len(Title) = 0 Then Title =
App.Title
lForecolor =
GetSysColor(COLOR_BTNTEXT)
If ForeColor >= 0 Then
lForecolor = ForeColor
'Show the Modified
MsgBox
lReturn = MsgBox(Prompt, Buttons, Title,
HelpFile, Context)
Call
UnhookWindowsHookEx(lHook)
MsgBoxEx = lReturn
End
Function
这个是个公共模块。但是图片是固定在资源文件里面,还没有想到其他办法,
如果有谁想到其他解决方法,请告诉我,大家可以互相学习哦。^_^
其中:
'LoadResPicture(101,
0).Handle
是资源文件中ID为101的图片。
也可以换成某个窗体的图片框中的图片。
例如:Form1.Picture1.Picture.Handle
弄张纯色图片当背景
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
'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
Public
Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As
VbMsgBoxStyle, Optional ByVal Title As String, Optional ByVal HelpFile As
String, Optional ByVal Context As Long, Optional ByVal ForeColor As
ColorConstants = -1) As Long
Dim lReturn As
Long
lHook = SetWindowsHookEx(WH_CALLWNDPROC,
AddressOf HookWindow, App.hInstance,
App.ThreadID)
'Set the
Defaults
If Len(Title) = 0 Then Title =
App.Title
lForecolor =
GetSysColor(COLOR_BTNTEXT)
If ForeColor >= 0 Then
lForecolor = ForeColor
'Show the Modified
MsgBox
lReturn = MsgBox(Prompt, Buttons, Title,
HelpFile, Context)
Call
UnhookWindowsHookEx(lHook)
MsgBoxEx = lReturn
End
Function
这个是个公共模块。但是图片是固定在资源文件里面,还没有想到其他办法,
如果有谁想到其他解决方法,请告诉我,大家可以互相学习哦。^_^
其中:
'LoadResPicture(101,
0).Handle
是资源文件中ID为101的图片。
也可以换成某个窗体的图片框中的图片。
例如:Form1.Picture1.Picture.Handle
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询