注册 | 登录
收藏 | 帮助
热门文章
编辑推荐
相关文章  
设置MSN可自动防卸MSN小尾巴
把秘密藏在图片中 另类加密软件大
另类:用Ftype巧妙清除病毒
清除不明进程msser 珊瑚QQ病毒防
知已知彼——MSN 信息安全攻防实
我的秘密你别看 另类方法保护资料
ORACLE应用经验(3)-DBMS_SQL封装
MYsql和MS sql7的数据转换
Oracle8i和MS SQL Server7.0比较
Oracle和MS SQL Server你选谁?
您现在的位置: 顶尖设计 >> IT学院 >> 编程开发 >> VB >> 文章正文
另类Msgbox
作者:40Star  来源:csdn  点击:  更新:2006-12-19
简介:
写过VB的人都知道Msgbox函数弹出系统提示对话框,这个对话框既然是Windows给我们使用的那么我们就可以通过别的方式改变它。
下面我就会调用MessageBox的Api来改变VB的对话框函数,创造出我们自己风格的Msgbox!
该例程是将Msgbox弹出,并且总是位于窗口的中央;而且修改了Msgbox中的“确定”按钮上的文字。程序中简单的使用了Windows的钩子。


1·加入一个模块:

Option Explicit
'--------------------API声明部分--------------------
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

'使用API的MessageBox替代VB系统的MsgBox
Private Declare Function MessageBox Lib "user32" _
   Alias "MessageBoxA" _
  (ByVal hWnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal wType As Long) 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 UnhookWindowsHookEx Lib "user32" _
   (ByVal hHook As Long) As Long

Private Declare Function MoveWindow Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long
  
Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hWnd As Long, _
   lpRect As RECT) As Long
  
Public Declare Function GetDlgItem Lib "user32" _
  (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
 
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
  (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long

Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" _
  (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long


Private hHook As Long
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
Private Const IDPROMPT = &HFFFF&

'----------------------窗体句柄----------------------'
Private hFormhWnd As Long

 


'''''''''''''''''''''''''''''''''''''''''''''''''''''
'替代VB中的Msgbox函数
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Msgbox(hWnd As Long, sPrompt As String, _
                       Optional dwStyle As Long, _
                       Optional sTitle As String) As Long
 
    Dim hInstance As Long
    Dim hThreadId As Long
   
    hInstance = App.hInstance
    hThreadId = App.ThreadID
   
    If dwStyle = 0 Then dwStyle = vbOKOnly
    If Len(sTitle) = 0 Then sTitle = App.EXEName
      
    '将当前窗口的句柄付给变量
    hFormhWnd = hWnd
   
    '设置钩子
    hHook = SetWindowsHookEx(WH_CBT, _
                            AddressOf CBTProc, _
                            hInstance, hThreadId)
    '调用MessageBox API
    Msgbox = MessageBox(hWnd, sPrompt, sTitle, dwStyle)

End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''
'HOOK处理
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CBTProc(ByVal nCode As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
     
    '变量声明
    Dim rc As RECT
    Dim rcFrm As RECT
   
    Dim newLeft As Long
    Dim newTop As Long
    Dim dlgWidth As Long
    Dim dlgHeight As Long
    Dim scrWidth As Long
    Dim scrHeight As Long
    Dim frmLeft As Long
    Dim frmTop As Long
    Dim frmWidth As Long
    Dim frmHeight As Long
    Dim hwndMsgBox As Long
   
'    Dim lngHwnd As Long
    '当MessageBox出现时,将Msgbox对话框居中与所在的窗口
    If nCode = HCBT_ACTIVATE Then
        '消息为HCBT_ACTIVATE时,参数wParam包含的是MessageBox的句柄
        hwndMsgBox = wParam
        '得到MessageBox对话框的Rect
        Call GetWindowRect(hwndMsgBox, rc)
        Call GetWindowRect(hFormhWnd, rcFrm)
        '使MessageBox居中
        frmLeft = rcFrm.Left
        frmTop = rcFrm.Top
        frmWidth = rcFrm.Right - rcFrm.Left
        frmHeight = rcFrm.Bottom - rcFrm.Top

        dlgWidth = rc.Right - rc.Left
        dlgHeight = rc.Bottom - rc.Top
     
        scrWidth = Screen.Width \ Screen.TwipsPerPixelX
        scrHeight = Screen.Height \ Screen.TwipsPerPixelY
     
        newLeft = frmLeft + ((frmWidth - dlgWidth) \ 2)
        newTop = frmTop + ((frmHeight - dlgHeight) \ 2)
        '修改确定按钮的文字
        Call SetDlgItemText(hwndMsgBox, IDOK, "这是确定按钮")
        'Msgbox居中
        Call MoveWindow(hwndMsgBox, newLeft, newTop, dlgWidth, dlgHeight, True)
     
        '卸载钩子
        UnhookWindowsHookEx hHook
    End If
    CBTProc = False

End Function

2·窗体中的代码:
Form1中的-----

    Option Explicit
 
    Private Sub Command1_Click()
        '变量声明
        Dim strTitle As String
        Dim strPrompt As String
        Dim lngStyle As Long
        'MessageBox的标题
        strTitle = "我的应用"
        'MessageBox的内容
        strPrompt = "这是 hook MessageBox 的演示" & vbCrLf & vbCrLf & _
                            "MessageBox的对话框将会居中在Form中"
        'MessageBox样式
        lngStyle = vbAbortRetryIgnore Or vbInformation
   
        Select Case Msgbox(hWnd, strPrompt, lngStyle, strTitle)
            Case vbRetry:  Text1.Text = "Retry button 按下"
            Case vbAbort:  Text1.Text = "Abort button 按下"
            Case vbIgnore: Text1.Text = "Ignore button 按下"
        End Select
    End Sub

    Private Sub Command2_Click()
        Form2.Show
    End Sub


Form2中的-----

    Option Explicit

    Private Sub Command1_Click()
        Call Msgbox(Me.hWnd, "确定按钮展示!", 0, "")
    End Sub






  • 上一篇文章:
  • 下一篇文章:
  • 分享此文:该页面添加到 Mister Wong 添加到雅虎Yahoo!收藏 Add to:Del.icio.us Post to Furl Digg this 添加到Google书签 reddit spurl blogmarks 365Key 评论  收藏  分享  打印
     我来说两句
    姓名:       验证码:   
    主页: 
    评分: 1分 2分 3分 4分 5分
    本频道近期热评文章:
      关于我们 | 联系我们 | 站点地图 | 广告投放 | 友情链接 | 在线留言 | 版权申明
    版权所有 © 2004-2007 顶尖设计(bobd.cn)
    未经授权禁止转载,摘编,复制本站内容或建立镜像. 沪ICP备07504942号 
    网络110
    报警服务