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 (希望可以解决问题)ma和mb文件无法正常打开,打开后是空白,但是有正常内存占用,但可以在打开Maya应用程序后打开场景ma和mb格式。
- ¥20 ML307A在使用AT命令连接EMQX平台的MQTT时被拒绝
- ¥20 腾讯企业邮箱邮件可以恢复么
- ¥15 有人知道怎么将自己的迁移策略布到edgecloudsim上使用吗?
- ¥15 错误 LNK2001 无法解析的外部符号
- ¥50 安装pyaudiokits失败
- ¥15 计组这些题应该咋做呀
- ¥60 更换迈创SOL6M4AE卡的时候,驱动要重新装才能使用,怎么解决?
- ¥15 让node服务器有自动加载文件的功能
- ¥15 jmeter脚本回放有的是对的有的是错的