Timed Msgbox Function: TMsgBox (1 Viewer)

Status
Not open for further replies.

ByteMyzer

AWF VIP
Local time
Today, 15:53
Joined
May 3, 2004
Messages
1,409
Below is documentation and code for a timed version of the MsgBox function for Microsoft Access. Copy the code and paste it into a new Module in your MDB project, then save the Module as mdlTMsgBox.

TMsgBox Function

Executes a timed version of the MsgBox function. It displays a message in a dialog box, waits for the user to click a button or for the specified timer duration to elapse, and returns an Integer indicating which button the user clicked. If the timer duration elapses before the user clicks a button on the dialog box, the dialog box closes and the function returns an Integer with the value assigned to the default button.

Syntax:
TMsgBox(prompt[, buttons] [, title] [, elapse])


The TMsgBox function syntax has these named arguments:

prompt: Required. String expression displayed as the message in the dialog box. The maximum length of prompt is approximately 1024 characters, depending on the width of the characters used. If prompt consists of more than one line, you can separate the lines using a carriage return character (Chr(13)), a linefeed character (Chr(10)), or carriage return – linefeed character combination (Chr(13) & Chr(10)) between each line.

buttons: Optional. Numeric expression that is the sum of values specifying the number and type of buttons to display, the icon style to use, the identity of the default button, and the modality of the message box. If omitted, the default value for buttons is 0.

title: Optional. String expression displayed in the title bar of the dialog box. If you omit title, the application name is placed in the title bar.

elapse: Optional. Numeric expression that determines the maximum duration, in milliseconds, that the dialog box is to be displayed. If omitted, the default duration as specified in the code is used.


mdlTMsgBox:
Code:
[COLOR="DarkGreen"]' Default duration in milliseconds[/COLOR]
[COLOR="Navy"]Private Const[/COLOR] cElapse [COLOR="navy"]As Long[/COLOR] = 10000

[COLOR="navy"]Private Declare Function[/COLOR] GetActiveWindow [COLOR="navy"]Lib[/COLOR] "user32" () _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] GetCurrentThreadId [COLOR="navy"]Lib[/COLOR] "kernel32" () _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] GetWindowLongA [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] nIndex [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] GetWindowTextA [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lpString [COLOR="navy"]As String[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] cch [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] KillTimer [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] nIDEvent [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] MessageBoxA [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lpText [COLOR="navy"]As String[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lpCaption [COLOR="navy"]As String[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] wType [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] PostMessageA [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] wMsg [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] wParam [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lParam [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] SetFocus [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] SetTimer [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] nIDEvent [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] uElapse [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lpTimerFunc [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] SetWindowsHookExA [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] idHook [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lpfn [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] hMod [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] dwThreadId [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] UnhookWindowsHookEx [COLOR="navy"]Lib[/COLOR] "user32" ( _
    [COLOR="navy"]ByVal[/COLOR] hHook [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

Private Const[/COLOR] GWL_HINSTANCE = (-6)
[COLOR="Navy"]Private Const[/COLOR] HCBT_ACTIVATE = 5
[COLOR="navy"]Private Const[/COLOR] HCBT_SETFOCUS = 9
[COLOR="navy"]Private Const[/COLOR] NV_CLOSEMSGBOX [COLOR="navy"]As Long[/COLOR] = &H5000&
[COLOR="navy"]Private Const[/COLOR] WH_CBT = 5
[COLOR="navy"]Private Const[/COLOR] WM_LBUTTONDOWN = &H201
[COLOR="navy"]Private Const[/COLOR] WM_LBUTTONUP = &H202
[COLOR="navy"]Private Const[/COLOR] WM_TIMER = &H113

[COLOR="navy"]Private[/COLOR] hDlgMsgBox [COLOR="navy"]As Long
Private[/COLOR] hHook [COLOR="navy"]As Long
Private[/COLOR] hTimerID [COLOR="navy"]As Long
Private[/COLOR] hWndApp [COLOR="navy"]As Long
Private[/COLOR] hWndMsgBox [COLOR="navy"]As Long


Private Sub[/COLOR] TimerClear()

    [COLOR="navy"]If[/COLOR] hWndApp <> 0 [COLOR="navy"]Then[/COLOR]
        KillTimer hWndApp, _
            NV_CLOSEMSGBOX
        hDlgMsgBox = 0
        hHook = 0
        hTimerID = 0
        hWndApp = 0
        hWndMsgBox = 0
    [COLOR="navy"]End If

End Sub


Public Function[/COLOR] MsgBoxHookProc( _
    [COLOR="Navy"]ByVal[/COLOR] uMsg [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] wParam [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] lParam [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

    Select Case[/COLOR] uMsg
        [COLOR="navy"]Case[/COLOR] HCBT_SETFOCUS
            hDlgMsgBox = wParam
        [COLOR="navy"]Case[/COLOR] HCBT_ACTIVATE
            hWndMsgBox = wParam
            UnhookWindowsHookEx hHook
    [COLOR="navy"]End Select

End Function


Public Function[/COLOR] TimerProc( _
    [COLOR="navy"]ByVal[/COLOR] hWnd [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] uMsg [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] idEvent [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] dwTime [COLOR="navy"]As Long[/COLOR]) _
    [COLOR="navy"]As Long

    Select Case[/COLOR] uMsg
        [COLOR="navy"]Case[/COLOR] WM_TIMER
            [COLOR="navy"]If[/COLOR] idEvent = NV_CLOSEMSGBOX [COLOR="navy"]Then[/COLOR]
                [COLOR="navy"]If[/COLOR] hWndMsgBox <> 0 [COLOR="navy"]Then[/COLOR]
                    [COLOR="navy"]If[/COLOR] hDlgMsgBox <> 0 [COLOR="navy"]Then[/COLOR]
                        SetFocus hDlgMsgBox
                        DoEvents
                        PostMessageA hDlgMsgBox, _
                            WM_LBUTTONDOWN, _
                            0, _
                            [COLOR="navy"]ByVal[/COLOR] 0&
                        PostMessageA hDlgMsgBox, _
                            WM_LBUTTONUP, _
                            0, _
                            [COLOR="navy"]ByVal[/COLOR] 0&
                    [COLOR="navy"]End If[/COLOR]
                    TimerClear
                [COLOR="navy"]End If
            End If
        Case Else
    End Select

End Function


Public Function[/COLOR] TMsgBox( _
    [COLOR="Navy"]ByVal[/COLOR] Prompt, _
    [COLOR="navy"]Optional ByVal[/COLOR] Buttons [COLOR="navy"]As[/COLOR] VbMsgBoxStyle = vbOKOnly, _
    [COLOR="navy"]Optional ByVal[/COLOR] Title, _
    [COLOR="navy"]Optional ByVal[/COLOR] Elapse) _
    [COLOR="navy"]As[/COLOR] VbMsgBoxResult

[COLOR="DarkGreen"]' For Access 97, use:
' Public Function TMsgBox( _
      ByVal Prompt, _
      Optional ByVal Buttons As Long, _
      Optional ByVal Title, _
      Optional ByVal Elapse) As Long[/COLOR]

    [COLOR="Navy"]Dim[/COLOR] hMod [COLOR="navy"]As Long
    Dim[/COLOR] hThreadId [COLOR="navy"]As Long
    Dim[/COLOR] lTitle [COLOR="navy"]As Long
    Dim[/COLOR] sTitle [COLOR="navy"]As String[/COLOR]

    hWndApp = GetActiveWindow

    hMod = GetWindowLongA(hWndApp, _
        GWL_HINSTANCE)
    hThreadId = GetCurrentThreadId()

    [COLOR="navy"]If[/COLOR] IsMissing(Title) = [COLOR="navy"]True Then[/COLOR]
        sTitle = String(255, 0)
        lTitle = GetWindowTextA(Application.hWndAccessApp, _
                                sTitle, 255)
        [COLOR="navy"]If[/COLOR] lTitle > 0 [COLOR="navy"]Then[/COLOR] sTitle = Left(sTitle, lTitle)
    [COLOR="navy"]Else[/COLOR]
        sTitle = Title
    [COLOR="navy"]End If

    If[/COLOR] IsMissing(Elapse) = [COLOR="navy"]True Then[/COLOR]
        Elapse = cElapse
    [COLOR="navy"]Else[/COLOR]
        Elapse = CLng(Elapse)
    [COLOR="navy"]End If[/COLOR]

    [COLOR="darkgreen"]' For Access 2000/2002/2003/2007[/COLOR]
    hHook = SetWindowsHookExA(WH_CBT, _
        [COLOR="navy"]AddressOf[/COLOR] MsgBoxHookProc, _
        hMod, hThreadId)
    [COLOR="navy"]If[/COLOR] Elapse > 0 [COLOR="navy"]Then[/COLOR]
        hTimerID = SetTimer(hWndApp, _
            NV_CLOSEMSGBOX, _
            Elapse, _
            [COLOR="navy"]AddressOf[/COLOR] TimerProc)
    [COLOR="navy"]End If[/COLOR]
    [COLOR="darkgreen"]' For Access 97
    '   You will need to download the code for the AddrOf
    '   function from Trigeminal Software at:
    '   http://www.trigeminal.com/lang/1033/codes.asp?ItemID=19#19
    '   Comment out the code under Access 2000/2002/2003/2007
    '   and Uncomment the following lines:
    'hHook = SetWindowsHookExA(WH_CBT, _
        AddrOf("MsgBoxHookProc"), _
        hMod, hThreadId)
    'If Elapse > 0 Then
    '    hTimerID = SetTimer(hWndApp, _
            NV_CLOSEMSGBOX, _
            Elapse, _
            AddrOf("TimerProc"))
    'End If[/COLOR]

    TMsgBox = MessageBoxA(hWndApp, _
        Prompt, _
        sTitle, _
        Buttons)

    TimerClear

[COLOR="navy"]End Function[/COLOR]
 
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom