Timer in Windows

[rotemfo]

Hi,
I am writing a simple application in VBScript to shutdown a database. I want a user to interact with a MsgBox and if the MsgBox is idle for 5 seconds, it will close and the application will continue.
How do i do that ?????
help appreciated
mailto:rotem_fo@hotmail.com
Thanks

 

[Phr3t]

well AFAIK, code stops when a msgbox is shown. so i think the best solution to your problem is to create a form that looks like a msgbox, and put a timer on it, then when it fires, unload the form. and make it so that the buttons on the msgbox form call subs on the main form.

i hope this helps...

Phr3t ------------------------------------------
ps. visit

http://www.mp3.com/dj_fret

for some of my muzic...
------------------------------------------
dex_fx@hotmail.com
dj_fret@hotmail.com
phr3t@hotmail.com

 

[JustinEzequiel]

put this in a module

  Option Explicit
  ' demo project showing how to use the API to manipulate a messagebox
  ' by Bryan Stafford of New Vision Software® - newvision@mvps.org
  ' this demo is released into the public domain "as is" without
  ' warranty or guaranty of any kind.  In other words, use at
  ' your own risk.
  '
  ' IMPORTANT NOTE:  the following constant is used to toggle desktop
  ' redrawing in this project.  if you set it equal to one (1), the project
  ' will turn off redrawing to the desktop.  Setting it to zero (0) will not
  ' lock the desktop.  if you will be stepping through the code in break
  ' mode, MAKE SURE YOU SET THIS CONSTANT TO ONE (1)!!!!  otherwise, you
  ' will not be able to see ANY screen updates!!!  also, on faster machines,
  ' turning off redrawing may not be necessary to achieve the desired effect.
  Public Const TURN_ON_UPDATES As Long = 0
  
  ' the max length of a path for the system (usually 260 or there abouts)
  ' this is used to size the buffer string for retrieving the class name of the active window below
  Public Const MAX_PATH As Long = 260&

  Public Const API_TRUE As Long = 1&
  Public Const API_FALSE As Long = 0&
  
  ' font *borrowed* from the form used to replace MessageBox font
  Public g_hBoldFont As Long
  
  Public Const MSGBOXTEXT As String = "Have you ever seen a standard message box with a different font than all the others on the system?"
  Public Const WM_SETFONT As Long = &H30&
  Public Const WM_SETTEXT As Long = &HC&

  ' made up constants for setting our timer
  Public Const NV_CLOSEMSGBOX As Long = &H5000&
  Public Const NV_MOVEMSGBOX As Long = &H5001&
  Public Const NV_MSGBOXCHNGFONT As Long = &H5002&

  ' MessageBox() Flags
  Public Const MB_ICONQUESTION As Long = &H20&
  Public Const MB_TASKMODAL As Long = &H2000&

  ' SetWindowPos Flags
  Public Const SWP_NOSIZE As Long = &H1&
  Public Const SWP_NOZORDER As Long = &H4&
  Public Const HWND_TOP As Long = 0&

  Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type

  ' API declares
  Public Declare Function GetActiveWindow& Lib "user32" ()
  
  Public Declare Function GetDesktopWindow& Lib "user32" ()
  
  Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, _
                                                                        ByVal lpWindowName$)

  Public Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent&, _
                              ByVal hWndChildAfter&, ByVal lpClassName$, ByVal lpWindowName$)

  Public Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal _
                                                        wMsg&, ByVal wParam&, lParam As Any)

  Public Const WM_CLOSE As Long = &H10&
  Public Const WM_SETREDRAW As Long = &HB&

  Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd&, ByVal wMsg&, _
                                                                ByVal wParam&, lParam As Any) As Long

  Public Declare Function MoveWindow& Lib "user32" (ByVal hWnd&, ByVal x&, ByVal y&, _
                                              ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&)

  Public Declare Function ScreenToClientLong& Lib "user32" Alias "ScreenToClient" (ByVal hWnd&, _
                                                                                    lpPoint&)
  
  Public Declare Function GetDC& Lib "user32" (ByVal hWnd&)
  Public Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hDC&)

  ' drawtext flags
  Public Const DT_WORDBREAK As Long = &H10&
  Public Const DT_CALCRECT As Long = &H400&
  Public Const DT_EDITCONTROL As Long = &H2000&
  Public Const DT_END_ELLIPSIS As Long = &H8000&
  Public Const DT_MODIFYSTRING As Long = &H10000
  Public Const DT_PATH_ELLIPSIS As Long = &H4000&
  Public Const DT_RTLREADING As Long = &H20000
  Public Const DT_WORD_ELLIPSIS As Long = &H40000
  
  Public Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC&, ByVal lpsz$, _
                                          ByVal cchText&, lpRect As RECT, ByVal dwDTFormat&)
  
  Public Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hWnd&, _
                                                        ByVal lpClassName$, ByVal nMaxCount&)

  Public Declare Function GetWindowRect& Lib "user32" (ByVal hWnd&, lpRect As RECT)
  
  Public Declare Function SetWindowPos& Lib "user32" (ByVal hWnd&, ByVal hWndInsertAfter&, _
                                      ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
                                      
  Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" (ByVal hWnd&, _
                                                ByVal lpText$, ByVal lpCaption$, ByVal wType&)

  Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, ByVal uElapse&, _
                                                                            ByVal lpTimerFunc&)
  
  Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)

Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
  ' this is a callback function.  This means that windows "calls back" to this function
  ' when it's time for the timer event to fire
  
  ' first thing we do is kill the timer so that no other timer events will fire
  KillTimer hWnd, idEvent
  
  ' select the type of manipulation that we want to perform
  Select Case idEvent
    Case NV_CLOSEMSGBOX '<-- we want to close this messagebox after 4 seconds
      Dim hMessageBox&
      
      ' find the messagebox window
      hMessageBox = FindWindow(&quot;#32770&quot;, &quot;Self Closing Message Box&quot;)
      
      ' if we found it send it a wm_close message
      If hMessageBox Then Call PostMessage(hMessageBox, WM_CLOSE, ByVal 0&, ByVal 0&)
      
    Case NV_MOVEMSGBOX '<-- we want to move this messagebox
      Dim hMsgBox&, xPoint&, yPoint&
      Dim stMsgBoxRect As RECT, stParentRect As RECT
      
      ' find the messagebox window
      hMsgBox = FindWindow(&quot;#32770&quot;, &quot;Position A Message Box&quot;)
    
      ' if we found it then move it
      If hMsgBox Then
        ' get the rect for the parent window and the messagebox
        Call GetWindowRect(hMsgBox, stMsgBoxRect)
        Call GetWindowRect(hWnd, stParentRect)
        
        ' calculate the position for putting the messagebox in the middle of the form
        xPoint = stParentRect.Left + (((stParentRect.Right - stParentRect.Left) \ 2) - _
                                              ((stMsgBoxRect.Right - stMsgBoxRect.Left) \ 2))
        yPoint = stParentRect.Top + (((stParentRect.Bottom - stParentRect.Top) \ 2) - _
                                              ((stMsgBoxRect.Bottom - stMsgBoxRect.Top) \ 2))
        
        ' make sure the messagebox will not be off the screen.
        If xPoint < 0 Then xPoint = 0
        If yPoint < 0 Then yPoint = 0
        If (xPoint + (stMsgBoxRect.Right - stMsgBoxRect.Left)) > _
                                          (Screen.Width \ Screen.TwipsPerPixelX) Then
          xPoint = (Screen.Width \ Screen.TwipsPerPixelX) - (stMsgBoxRect.Right - stMsgBoxRect.Left)
        End If
        If (yPoint + (stMsgBoxRect.Bottom - stMsgBoxRect.Top)) > _
                                          (Screen.Height \ Screen.TwipsPerPixelY) Then
          yPoint = (Screen.Height \ Screen.TwipsPerPixelY) - (stMsgBoxRect.Bottom - stMsgBoxRect.Top)
        End If
        
        
        ' move the messagebox
        Call SetWindowPos(hMsgBox, HWND_TOP, xPoint, yPoint, _
                                        API_FALSE, API_FALSE, SWP_NOZORDER Or SWP_NOSIZE)
      End If
      
      ' unlock the desktop
      If TURN_ON_UPDATES Then Call SendMessage(GetDesktopWindow(), WM_SETREDRAW, ByVal API_TRUE, ByVal 0&)
      
      
    Case NV_MSGBOXCHNGFONT '<-- we want to change the font for this messagebox
      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ' NOTE: Changing the font of a message box is not recomemded!!
      '       This portion of the demo is just provided to show some of the possibilities
      '       for manipulating other windows using the Windows API.
      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      
      ' find the messagebox window
      hMsgBox = FindWindow(&quot;#32770&quot;, &quot;Change The Message Box Font&quot;)
    
      ' if we found it then find the static control that holds the text...
      If hMsgBox Then
        Dim hStatic&, hButton&, stMsgBoxRect2 As RECT
        Dim stStaticRect As RECT, stButtonRect As RECT
        
        ' find the static control that holds the message text
        hStatic = FindWindowEx(hMsgBox, API_FALSE, &quot;Static&quot;, MSGBOXTEXT)
        hButton = FindWindowEx(hMsgBox, API_FALSE, &quot;Button&quot;, &quot;OK&quot;)
        
        ' if we found it, change the text and resize the static control so it will be displayed
        If hStatic Then
          ' get the rects of the message box and the static control before we change the font
          Call GetWindowRect(hMsgBox, stMsgBoxRect2)
          Call GetWindowRect(hStatic, stStaticRect)
          Call GetWindowRect(hButton, stButtonRect)
          
          ' set the font we borrowed from the form into the static control
          Call SendMessage(hStatic, WM_SETFONT, g_hBoldFont, ByVal API_TRUE)
          
          ' you could change the button text to anything you want using the next line...
          Call SendMessage(hButton, WM_SETTEXT, ByVal 0&, ByVal &quot;Close&quot;)
          
          With stStaticRect
            ' convert the rect from screen coordinates to client coordinates
            Call ScreenToClientLong(hMsgBox, .Left)
            Call ScreenToClientLong(hMsgBox, .Right)
            
            Dim nRectHeight&, nHeightDifference&, hStaticDC&
            
            ' get the current height of the static control
            nHeightDifference = .Bottom - .Top
            
            ' get the device context of the static control to pass to DrawText
            hStaticDC = GetDC(hStatic)
            
            ' use DrawText to calculate the new height of the static control
            nRectHeight = DrawText(hStaticDC, MSGBOXTEXT, (-1&), stStaticRect, _
                                              DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK)
            
            ' release the DC
            Call ReleaseDC(hStatic, hStaticDC)
            
            ' calculate the difference in height
            nHeightDifference = nRectHeight - nHeightDifference
            
            ' resize the static control so that the new larger bold text will fit in the messagebox
            Call MoveWindow(hStatic, .Left, .Top, .Right - .Left, nRectHeight, API_TRUE)
          End With
            
          ' move the button to the new position
          With stButtonRect
            ' convert the rect from screen coordinates to client coordinates
            Call ScreenToClientLong(hMsgBox, .Left)
            Call ScreenToClientLong(hMsgBox, .Right)
            
             ' move the button
            Call MoveWindow(hButton, .Left, .Top + nHeightDifference, .Right - .Left, .Bottom - .Top, API_TRUE)
          End With
          
          With stMsgBoxRect2
            ' resize and reposition the messagebox
            Call MoveWindow(hMsgBox, .Left, .Top - (nHeightDifference \ 2), .Right - .Left, (.Bottom - .Top) + nHeightDifference, API_TRUE)
          
            ' NOTE: if your message is very long, you may need to add code to make sure the messagebox
            ' will not run off the screen....
          End With
        End If
      End If
      
      ' unlock the desktop
      If TURN_ON_UPDATES Then Call SendMessage(GetDesktopWindow(), WM_SETREDRAW, ByVal API_TRUE, ByVal 0&)
  
  End Select
  
End Sub

put this in a form

  Option Explicit
  ' demo project showing how to use the API to manipulate a messagebox
  ' by Bryan Stafford of New Vision Software® - newvision@mvps.org
  ' this demo is released into the public domain "as is" without
  ' warranty or guaranty of any kind.  In other words, use at
  ' your own risk.

Private Sub Command1_Click()
  ' this shows a messagebox that will be dismissed after 4 seconds
  
  ' set the callback timer and pass our application defined ID (NV_CLOSEMSGBOX)
  ' set the time for 4 seconds (4000& microseconds)
  SetTimer hWnd, NV_CLOSEMSGBOX, 4000&, AddressOf TimerProc

  ' call the messagebox API function
  Call MessageBox(hWnd, "Watch this message box close itself after four seconds", _
      "Self Closing Message Box", MB_ICONQUESTION Or MB_TASKMODAL)
  
End Sub

Private Sub Command2_Click()
  ' this positions the messagebox in the desired location on the screen.
  ' the location is defined in the callback timer function
  
  ' lock the desktop so that the initial position is not shown
  If TURN_ON_UPDATES Then Call SendMessage(GetDesktopWindow(), WM_SETREDRAW, ByVal API_FALSE, ByVal 0&)
  
  ' set the callback timer with our application defined ID (NV_MOVEMSGBOX)
  ' set the time for 10 microseconds to allow the messagebox time to become active
  SetTimer hWnd, NV_MOVEMSGBOX, 10&, AddressOf TimerProc

  ' call the messagebox API function
  Call MessageBox(hWnd, "Have you ever seen a message box that wasn't in the middle of the screen?", _
                                        "Position A Message Box", MB_ICONQUESTION Or MB_TASKMODAL)

End Sub

Private Sub Command3_Click()
  ' this changes th font for the message text of the messagebox.
  ' the routine in the callback timer function
  
  ' lock the desktop so that the initial font is not shown
  If TURN_ON_UPDATES Then Call SendMessage(GetDesktopWindow(), WM_SETREDRAW, ByVal API_FALSE, ByVal 0&)
  
  ' set the callback timer with our application defined ID (NV_MSGBOXCHNGFONT)
  ' set the time for 10 microseconds to allow the messagebox time to become active
  SetTimer hWnd, NV_MSGBOXCHNGFONT, 10&, AddressOf TimerProc

  ' call the messagebox API function
  Call MessageBox(hWnd, MSGBOXTEXT, "Change The Message Box Font", MB_ICONQUESTION Or MB_TASKMODAL)

End Sub

Private Sub Form_Load()

  ' we will use the font from the form to change the text in one of our message boxes
  ' first, set the attributes of the font that we will want to display.
  With Font
    .Bold = True
    .Italic = True
  End With
  
  ' next, grab a handle to the form's font and store it in the global variable for use later.
  ' don't change the font on the form or the value in the global variable will be invalid.
  Dim IFont As IFont
  Set IFont = Font

  g_hBoldFont = IFont.hFont
  
  Set IFont = Nothing
  
End Sub