VB怎么自己写一个MSGBOX函数,定时关闭自己,并且可以选择一个默认的命令?
2条回答
- danielinbiti 2016-05-08 01:49关注
方法一: 自己建一个窗体,通过showmodal方式模拟弹出窗口,这个是最简单的。 方法二: moduls.pas Option Explicit Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long Private Const TIME_PERIODIC As Long = 1 ' program for continuous periodic event Private Const TIME_ONESHOT As Long = 0 ' program timer for single event 'Public MediaCount As Double '累加量 Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long 'Public Const WM_GETTEXT As Long = &HD& Private Const WM_SETTEXT As Long = &HC& Private Const WM_CLOSE As Long = &H10& Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private TimeID As Long '返回多媒体记时器对象标识 Private Dlghwnd As Long '对话框句柄 Private Dlgtexthwnd As Long '对话框提示文本句柄 Private MsgboxClosetime As Long '设置对话框关闭时间 Private MsgboxPromtText As String '设置对话框提示文本 '枚举所有顶级窗口 Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim WindowCaption As String, CaptionLength As Long, WindowClassName As String * 256 CaptionLength = GetWindowTextLength(hWnd) WindowCaption = Space(CaptionLength) Call GetWindowText(hWnd, WindowCaption, CaptionLength + 1) If InStr(1, WindowCaption, MsgboxPromtText) > 0 Then Dlghwnd = hWnd End If EnumWindowsProc = 1 End Function '枚举所有子窗口 Private Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim WindowCaption As String, CaptionLength As Long, WindowClassName As String * 256 CaptionLength = GetWindowTextLength(hWnd) WindowCaption = Space(CaptionLength) Call GetWindowText(hWnd, WindowCaption, CaptionLength + 1) Call GetClassName(hWnd, WindowClassName, 256) If InStr(1, WindowClassName, "Static") > 0 Then Dlgtexthwnd = hWnd End If EnumChildWindowsProc = 1 End Function 'API函数timeSetEvent使用的回调函数 Private Function TimeSetProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long Dim cText As String Static MediaCount As Double ', Msghwnd1 As Long, Msghwnd2 As Long MediaCount = MediaCount + 0.5 If Dlgtexthwnd > 0 Then cText = CStr(MsgboxClosetime - Fix(MediaCount)) & "秒后自动关闭!" Call SendMessage(Dlgtexthwnd, WM_SETTEXT, Len(cText), ByVal cText) If Val(cText) = 0 Then MediaCount = 0 Call SendMessage(Dlghwnd, WM_CLOSE, 0, 0) '时间到,关闭对话框 Call timeKillEvent(TimeID) '删除多媒体计时器标识 End If Else Call EnumWindows(AddressOf EnumWindowsProc, 0) If Dlghwnd > 0 Then Call EnumChildWindows(Dlghwnd, AddressOf EnumChildWindowsProc, 0) End If End If TimeSetProc = 1 End Function '定时关闭对话框:Closetime参数设置对话框关闭时间;Msgboxtitle参数设置对话框提示文本;vbButtons参数是设置对话框按钮及图标。 Public Function Fixedtimeclosemsgbox(ByVal Closetime As Long, ByVal Msgboxtitle As String, Optional vbButtons As VbMsgBoxStyle = vbOKOnly) As Long Dim Information As Long Dlghwnd = 0: Dlgtexthwnd = 0 MsgboxClosetime = Closetime MsgboxPromtText = Msgboxtitle TimeID = timeSetEvent(500, 0, AddressOf TimeSetProc, 1, TIME_PERIODIC) '时间间隔为500毫秒 Information = MsgBox(Closetime & "秒后自动关闭!", vbButtons, Msgboxtitle) '定义msgbox对话框 Call timeKillEvent(TimeID) '删除多媒体计时器标识 Fixedtimeclosemsgbox = 1 End Function 使用 Call Fixedtimeclosemsgbox(10, "VB6倒计时对话框", vbYesNoCancel + vbInformation + vbSystemModal)
本回答被题主选为最佳回答 , 对您是否有帮助呢?解决 无用评论 打赏 举报
悬赏问题
- ¥15 matlab有限元法求解梁带有若干弹簧质量系统的固有频率
- ¥15 找一个网络防御专家,外包的
- ¥100 能不能让两张不同的图片md5值一样,(有尝)
- ¥15 informer代码训练自己的数据集,改参数怎么改
- ¥15 请看一下,学校实验要求,我需要具体代码
- ¥50 pc微信3.6.0.18不能登陆 有偿解决问题
- ¥20 MATLAB绘制两隐函数曲面的交线
- ¥15 求TYPCE母转母转接头24PIN线路板图
- ¥100 国外网络搭建,有偿交流
- ¥15 高价求中通快递查询接口