请选择 进入手机版 | 继续访问电脑版
设为首页收藏本站

就爱编程论坛

 找回密码
 注册

人人连接登陆

无需注册,直接登录

用新浪微博连接

一步搞定

QQ登录

只需一步,快速开始

查看: 1832|回复: 0

vb来创建倒计时msgbox [复制链接]

Rank: 9Rank: 9Rank: 9

  • TA的每日心情

    2017-2-21 09:45:45
  • 签到天数: 381 天

    [LV.9]以坛为家II

    论坛先锋 学习至圣 荣誉成员 论坛元老 活跃之星 终极领袖

    发表于 2012-10-23 22:58:59 |显示全部楼层
    使用hook技术
    用vb来创建倒计时msgbox,很有意思的。该代码用SetWindowsHookEx创建hook来截获msgbox的创建,并改变它的外观,而且使用了timer来显示倒计时。
    代码开始初始化要显示的msgbos上的内容,并设置倒计时的间隔,设置时间计时完毕的默认执行按钮。timer事件中,使用GetDlgItem来获得“默认动作”按钮的句柄(由dwTimerExpireButton标识指定),发送postmessage给默认执行按钮WM_LBUTTONDOWN和WM_LBUTTONUP消息,模拟点击动作。当然在msgbox显示的过程中,用户也可以点击按钮来结束msgbox,同时timer结束。
    demo使用了3个按钮,可以是“取消”-“重试”-“忽略”或者“OK”-“NO”-“cancel”等待,这里为了说明,我定义了3个常数:IDSELECT,IDBEGIN和IDSKIP,并赋值为windows的:IDABORT,IDRETRY,IDIGNORE常数值,在代码中可以直接用dwTimerExpireButton=IDRETRY等等。
    新建工程,添加个bas,复制下面代码:
    Option Explicit
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Distribution: isumh coded.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'timer事件使用
    Public hwndMsgBox As Long

    '自定义用户类型,传递一堆参数
    Public Type CUSTOM_MSG_PARAMS
       hOwnerThread         As Long
       hOwnerWindow         As Long
       dwStyle              As Long
       bUseTimer            As Boolean
       dwTimerDuration      As Long
       dwTimerInterval      As Long
       dwTimerExpireButton  As Long
       dwTimerCountDown     As Long
       sTitle               As String
       sPrompt              As String
    End Type

    Public cmp As CUSTOM_MSG_PARAMS

    '常数
    Public Const MB_ICONINFORMATION As Long = &H40&
    Private Const MB_ABORTRETRYIGNORE As Long = &H2&
    Private Const MB_TASKMODAL As Long = &H2000&

    'Windows   MessageBox 返回值
    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

    '这部分有用户自定义常量,来表示按钮的动作,在现有的MessageBox常量的基础上
    Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
    Public Const IDSELECT = IDABORT
    Public Const IDBEGIN = IDRETRY
    Public Const IDSKIP = IDIGNORE
    Public Const IDPROMPT = &HFFFF&

    '其它api常数
    Private Const WH_CBT = 5
    Private Const GWL_HINSTANCE = (-6)
    Private Const HCBT_ACTIVATE = 5
    Public Const WM_LBUTTONDOWN = &H201
    Public Const WM_LBUTTONUP = &H202

    '用户自定义类型在hook时传递数据。
    Private Type MSGBOX_HOOK_PARAMS
       hwndOwner   As Long
       hHook       As Long
    End Type

    '变量
    Private MHP As MSGBOX_HOOK_PARAMS

    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

    Public Declare Function GetDesktopWindow Lib "user32" () As Long

    Private Declare Function GetWindowLong Lib "user32" _
       Alias "GetWindowLongA" _
      (ByVal hwnd As Long, _
       ByVal nIndex As Long) As Long

    Public Declare Function GetDlgItem Lib "user32" _
      (ByVal hDlg As Long, _
       ByVal nIDDlgItem As Long) As Long
       
    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
       
    Public Declare Function PostMessage Lib "user32" _
       Alias "PostMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, lParam As Long) As Long
          
    Public Declare Function PutFocus Lib "user32" _
       Alias "SetFocus" _
      (ByVal hwnd As Long) As Long
      
    Public Declare Function SetDlgItemText Lib "user32" _
       Alias "SetDlgItemTextA" _
      (ByVal hDlg As Long, _
       ByVal nIDDlgItem As Long, _
       ByVal lpString As String) 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 SetWindowText Lib "user32" _
       Alias "SetWindowTextA" _
      (ByVal hwnd As Long, _
       ByVal lpString As String) As Long

    Private Declare Function UnhookWindowsHookEx Lib "user32" _
       (ByVal hHook As Long) As Long
         


    Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                                   ByVal wParam As Long, _
                                   ByVal lParam As Long) As Long
          
      '当message box 显示时,我们改变标题,提示信息和按钮caption
       If uMsg = HCBT_ACTIVATE Then
       
         '在HCBT_ACTIVATE消息中,
         'wparam参数是messagebox的句柄,在timer事件中需要使用
          hwndMsgBox = wParam
                  
         '设置message box的按钮caption      
          SetDlgItemText wParam, IDSELECT, "选择.."
          SetDlgItemText wParam, IDBEGIN, "开始"
          SetDlgItemText wParam, IDSKIP, "跳过"
          
         '脱钩
          UnhookWindowsHookEx MHP.hHook
                   
       End If
       
      '正常处理继续
       MsgBoxHookProc = False

    End Function


    Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long

       Dim hInstance As Long
       Dim hThreadId As Long
       
      '挂钩
       hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
       hThreadId = GetCurrentThreadId()

      '填写 MSGBOX_HOOK_PARAMS 结构值
      '将hook设为其中一个参数,我们就能截获消息并能操作对话框。
       With MHP
          .hwndOwner = cmp.hOwnerWindow
          .hHook = SetWindowsHookEx(WH_CBT, _
                                    AddressOf MsgBoxHookProc, _
                                    hInstance, hThreadId)
       End With
       
      '设置倒计数 0
       cmp.dwTimerCountDown = 0
       
      '如果bUseTimer, 那么就enable timer. 因为
      'MessageBox API 和 MsgBox 类似,必须关闭才能执行下一条语句。
      '对话框一显示,timer的事件就动态更新message box的显示
       With Form1.Timer1
          .Interval = cmp.dwTimerInterval
          .Enabled = cmp.bUseTimer
       End With

      '调用 MessageBox API
      
       TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
                                     cmp.sPrompt, _
                                     cmp.sTitle, _
                                     cmp.dwStyle)

      'timer不需要了
       Form1.Timer1.Enabled = False

    End Function

    form1中添加text1,command1,timer1,复制下面代码:

    Option Explicit

    Private Sub Command1_Click()
      
      '显示message box,
      '传递 CUSTOM_MSG_PARAMS结构
       With cmp
          .sTitle = "倒计时 MessageBox Hook Demo"
          .sPrompt = "要马上执行,选择开始." & vbCrLf & _
                     "或点击选择." & vbCrLf & vbCrLf & _
                     "将在 10 后自动执行。" & Space$(20)
          .dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
          .bUseTimer = True               '如果true,timer会更新显示每 dwTimerInterval
          .dwTimerDuration = 10           '等待秒数
          .dwTimerInterval = 1000         '倒计时秒数
          .dwTimerExpireButton = IDBEGIN  'timeout执行动作
          .dwTimerCountDown = 0           '
          .hOwnerThread = Me.hwnd         '调用窗口句柄
          .hOwnerWindow = Me.hwnd         '包含窗口(me.hwnd or desktop).
                                          
       End With

       Select Case TimedMessageBoxH(cmp)
          Case IDSELECT: Text1.Text = "在 timeout 前 选择 按钮被按下"
          Case IDBEGIN:  Text1.Text = "按下 开始 或者 timeout "
          Case IDSKIP:   Text1.Text = " timeout 前 按下 跳过 "
       End Select
         
    End Sub

    Private Sub Timer1_Timer()

       Dim hWndTargetBtn As Long
       
       If hwndMsgBox <> 0 Then
       
         '计数
          cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1

         '更新提示计时信息
          SetDlgItemText hwndMsgBox, IDPROMPT, _
                         "要马上执行,选择开始." & vbCrLf & _
                         "或点击选择." & vbCrLf & vbCrLf & _
                         "将在 " & _
                         CStr(10 - cmp.dwTimerCountDown) & " 秒后自动执行"
                                 

         '如果倒计时完毕,要模拟点击
          If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
          
            '停止timer
             Timer1.Enabled = False
             
            '获取按钮句柄
             hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
             
             If hWndTargetBtn <> 0 Then
             
               '在按钮上设置焦点
                Call PutFocus(hWndTargetBtn)
               
               '给PutFocus时间
                DoEvents
                
               '模拟点击
                Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
                Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
             
             End If
             
          End If
                                           
       End If
       
    End Sub
    [img=http://mail.qq.com/cgi-bin/qm_share?t=qm_mailme&email=fRUcHhYWGAQ9GxIFEBwUEVMeEhA]http://rescdn.qqmail.com/zh_CN/htmledition/images/function/qm_open/ico_mailme_02.png[/img]

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册 人人连接登陆

    晴云孤魂's Blog|就爱编程搜帖|手机版|Archiver|就爱编程论坛     

    GMT+8, 2017-11-23 13:24 , Processed in 0.072433 second(s), 24 queries .

    Powered by Discuz! X2

    © 2001-2011 Comsenz Inc.

    回顶部 54.162.166.214 - - [23/Nov/2017:13:24:44 +0800] GET /thread-8800-1-1.html HTTP/1.0 200 48831 - CCBot/2.0 (http://commoncrawl.org/faq/) -