VB怎么自己写一个MSGBOX函数,定时关闭自己,并且可以选择一个默认的命令?
方法一:
自己建一个窗体,通过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)
VB form 可以当作对话框用
在 定时器消息中 关闭自己就可以了
大概是 end,unload form之类的