打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
VB改变MsgBox对话框的字体、颜色、背景图片。
##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
            '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
这样就不局限在资源文件里面了。后来发现
 
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
【热】打开小程序,算一算2024你的财运
VB入门技巧N例(5)
Excel中响应键盘事件(VBA)
如何在VB中判断Windows9x的运行模式
VB实用代码,收藏!!
VB 查找游戏窗口句柄的方法
Excel制表技巧(29)自定义B
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服