I display a message box with only an OK button. If a certain amount of time goes by and the user hasn't clicked it how can the program do it.
Printable View
I display a message box with only an OK button. If a certain amount of time goes by and the user hasn't clicked it how can the program do it.
Make your own message box (from a form) and incorporate a timer into it that will close the form?
I use this function...I put it in a module so it is project wide:
I call it like this:Code:Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Const WM_CLOSE As Long = 16
Private CurMBTitle As String
Public Function TimedMsgBox(Prompt As String, Optional ByVal TimeOut As Long = 0, Optional Icon As VbMsgBoxStyle = vbOKOnly, Optional Title As String = vbNullString)
Dim TimerId As Long
CurMBTitle = Title
If TimeOut = 0 Then
TimeOut = 5 * 1000
Else
TimeOut = TimeOut * 1000
End If
TimerId = SetTimer(0, 0, TimeOut, AddressOf TimeOutMB)
TimedMsgBox = MsgBox(Prompt, Icon, CurMBTitle)
TimedMsgBox = 0
KillTimer 0, TimerId
End Function
Code:TimedMsgBox "Done--This Message will disappear in 3 seconds.", _
3, _
64, _
"MSG BOX TITLE"
Jeez!!! Thanks, Bonnie...the more I hang out here, the more I learn....!
That's really cool. The only problem I see is that it isn't modal but even at that it perfect for what I need it for.Quote:
Originally Posted by Bonnie West
What is the time interval in relations to the 5
The Popup messagebox isn't "owned" by VB which is why it's not modal to the Form. I guess that's the drawback to that one-liner. :o If you require a modal MsgBox, I'm pretty sure Sam's code will be just perfect.
@Sam
AddressOf TimeOutMB
Did you forget something?
Although you're one liner is great for my purpose one needs to be careful when using it.
For example:
When displayed and user puts focus on another object, like a textbox, the message box goes behind the Form and will remain static (it appears to loose it's timer) until user either moves form out of the way and clicks on OK or user puts the focus on another application.
I agree with ColinE66 (post #2) using a form to create whatever you desire to do with your messagebox. Also you create a public/private function call it MessageBox(TextCaption As String, Argument2, Argument3).
Hey Max, what was wrong with my post (#3)? I've been using that for quite some time. Sometimes global in module, sometimes only in a form if its a one-form app. Works fine.
Nothing wrong with your code sam, I think it's great.
I like to create my own usercontrol/form when something like that is needed.
Your code does not require extra forms or usercontrols, which is also a plus.
Well it's only great if it works, which it doesn't
Thx....and I understand. But I DO like Bonnie;s one-liner. (Will have to check out what jms said about it losing it's timer.......)
Sam, are you going to fix your code or not?
Jmsrickland try this, it might not be perfect but it's a start.
You can make it system modal: (although under some circumstances it still appears to 'lose' the timer)Quote:
Originally Posted by jmsrickland
EDIT: I guess with a bit of jiggery-pokery you could 'capture' the mouse such that it couldn't move out of the popup window - but then again, that'd probably irritate the end userCode:Dim wShell As Object
Dim lngRet As Long
Set wShell = CreateObject("WScript.Shell")
lngRet = wShell.Popup("Don't click me!", 5, "Auto-OK MsgBox", vbOKOnly Or vbInformation Or &H1000)
@ Doogle
I tried your modification but it didn't make the MsgBox modal to my Form. :confused:
Anyway, I decided to use APIs similar to Sam's post so that the MsgBox call isn't altered in any way. Here is a more complicated but reliable MsgBox auto-closing code:
Code:'In a BAS module
Option Explicit
Private Const MAX_CLASS_NAME As Long = 256
Private Const HCBT_ACTIVATE As Long = 5
Private Const WH_CBT As Long = 5
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function EndDialog Lib "user32.dll" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Private Declare Function GetClassNameW Lib "user32.dll" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, Optional ByVal lpTimerFunc As Long) As Long
Private Declare Function SetWindowsHookExW Lib "user32.dll" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Private m_hHook As Long
Private m_MilSecsToWait As Long
Private m_DefaultRetVal As VbMsgBoxResult
Public Function AutoCloseMsgBox(ByVal SecondsToWait As Long, Optional ByVal DefaultRetVal As VbMsgBoxResult = vbOK) As Boolean
m_MilSecsToWait = SecondsToWait * 1000& 'Should be in milliseconds
m_DefaultRetVal = DefaultRetVal
m_hHook = SetWindowsHookExW(WH_CBT, AddressOf CBTProc, 0&, App.ThreadID)
AutoCloseMsgBox = m_hHook <> 0&: Debug.Assert AutoCloseMsgBox
End Function
Private Function GetClassName(ByVal hWnd As Long) As String
SysReAllocStringLen VarPtr(GetClassName), , MAX_CLASS_NAME
SysReAllocStringLen VarPtr(GetClassName), StrPtr(GetClassName), _
GetClassNameW(hWnd, StrPtr(GetClassName), MAX_CLASS_NAME + 1&)
End Function
Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case nCode
Case HCBT_ACTIVATE
If GetClassName(wParam) = "#32770" Then 'The classname of a dialog box
CBTProc = SetTimer(wParam, lParam, m_MilSecsToWait, AddressOf TimerProc): Debug.Assert CBTProc
CBTProc = UnhookWindowsHookEx(m_hHook): Debug.Assert CBTProc
End If
End Select
CBTProc = CallNextHookEx(0&, nCode, wParam, lParam)
End Function
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
uMsg = KillTimer(hWnd, idEvent): Debug.Assert uMsg
uMsg = EndDialog(hWnd, m_DefaultRetVal): Debug.Assert uMsg
End Sub
Code:Private Sub Form_Activate() 'Sample usage
AutoCloseMsgBox 5&, vbOK 'Call it just before showing the MsgBox
Debug.Print "MsgBox = " & MsgBox("Don't click me!", vbInformation, "Auto-Close MsgBox")
End Sub
There is no fixing necessary....if you MUST know what the address of TimeOutMB is, put a print statement in there...Quote:
Originally Posted by jmsrickland
The code works just fine...have you even tried it?
@Sam
Yes I tried your code but it fails on that statement. I get Compile Error: Expected Sub, Function, or Property. Sorry, Sam, I'm only stating what's happening. TimeOutMB does not exist in the code other than where you put it as Address of TimeOutMB. I don't understand what you mean by put a print statement there.
EDIT: Ignore this code. You don't need two apps as Bonnie explained it in post #25
Here's a way I figured out. Probably silly but.......
Use two applications
App 1 is the application with the MsgBox
App 2 is the application with the timer control and the code to find the MsgBox Window/Button and click on it
Code for App 1
Code:Private Sub Command1_Click()
Shell Chr(34) & App.Path & "\ClickMBButton.exe" & Chr(34), vbNormalFocus
MsgBox "Another App will click my button", vbOKOnly, "Test MsgBox"
Caption = "MsgBox OK Button Clinked"
End Sub
Code for App 2 (which I called ClickMBButton)
Code:Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const BM_CLICK = &HF5
Private Const WM_SETFOCUS = &H7
Private Sub Form_Load()
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
MsgBoxHwnd = FindWindow(vbNullString, "Test MsgBox")
If MsgBoxHwnd Then
EnumChildWindows MsgBoxHwnd, AddressOf EnumChildProc, &H0
End If
SetForegroundWindow MsgBoxButtonHwnd
SendMessage MsgBoxButtonHwnd, WM_SETFOCUS, 0, 0
SendMessage MsgBoxButtonHwnd, BM_CLICK, 0, 0
Unload Me
End Sub
Module Code for App 2
Code:Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" _
(ByVal hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public MsgBoxHwnd As Long
Public MsgBoxButtonHwnd As Long
Public Function TrimNull(startstr As String) As String
Dim pos As Integer
pos = InStr(startstr, Chr$(0))
If pos Then
TrimNull = Left$(startstr, pos - 1)
Exit Function
End If
TrimNull = startstr
End Function
Public Function GetWindowIdentification(ByVal hwnd As Long, _
sIDType As String, sClass As String) As String
Dim nSize As Long
Dim sTitle As String
nSize = GetWindowTextLength(hwnd)
'if the return is 0, there is no title
If nSize > 0 Then
sTitle = Space$(nSize + 1)
Call GetWindowText(hwnd, sTitle, nSize + 1)
sIDType = "title"
sClass = Space$(64)
Call GetClassName(hwnd, sClass, 64)
Else
'no title, so get the class name instead
sTitle = Space$(64)
Call GetClassName(hwnd, sTitle, 64)
sClass = sTitle
sIDType = "class"
End If
GetWindowIdentification = TrimNull(sTitle)
End Function
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sTitle As String
Dim sClass As String
Dim sIDType As String
'
' get the window title/class name
'
sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
If InStr(sTitle, "OK") <> 0 Then
MsgBoxButtonHwnd = hwnd
End If
EnumChildProc = 1
End Function
looks like alot of code for a simple thing!
Have you tried my code?
It is a lot of code. That's why I said it probably silly. I was just playing around out of curiosity. It works.
Yes, I tried your code. I like it. Thanks, Max. Nice job
Lo siento, lo siento, lo siento....I failed to copy a function inside the module......mea culpaQuote:
Originally Posted by jmsrickland
Add this to that code above:
Code:Private Sub TimeOutMB(hwnd As Long, uMsg As Long, idEvent As Long, dwTime As Long)
SendMessage FindWindow(vbNullString, CurMBTitle), WM_CLOSE, 0&, 0&
End Sub
There's no need to have a separate App, just add a Timer to the Form and enable it before showing the MsgBox. Of course, VB's Timer control is disabled by the MsgBox in the IDE but runs fine when compiled. That is why my and Sam's code uses SetTimer instead.
Oh, cr_p! I only tested it in the IDE and it didn't work. That's why I made two apps. Yeah, now that I compiled it to EXE it does work.
OK, forget about that stupid post #21
OK, now it's missing SetTimerQuote:
Originally Posted by SamOscarBrown
TimerId = SetTimer(0, 0, TimeOut, AddressOf TimeOutMB)
?
Oh well, to precluded any copy-paste....attached is the module (complete)
And, like I said, add this to a project and call it with something in the same format as my orig code....added no timer controls, references or components.
If this doesn't work for you....I am sorry for haven take so much of your time.....:-(
Perfect!Quote:
Originally Posted by SamOscarBrown
LOL. One modal form. One label. One timer. Job done...
And one button!Quote:
Originally Posted by ColinE66
Nah. That'd be bloat-ware...
Problem: When I added a Statusbar control to the Form the message box no longer works; it stays static and the button must be clicked to close itQuote:
Originally Posted by Bonnie West
Well, it looks like the WScript MsgBox isn't very compatible with VB6 after all. I don't know if that can be fixed. I thought you decided to go with Sam's code?Quote:
Originally Posted by jmsrickland
No, I liked Sam's code but I used yours instead because it was the simplest of all and it didn't matter for my purposes whether it was modal or not. I was just pointing out some of the problems for others in case they wanted to use your one-liner.
Strange behavior with this WScript. It's still a nice method