Source code for Issue Number 35

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

You will need to add a new form to your project (change the Name property to frmTimedMsgBox), add a Timer control (change the Name property to tmrMsg), Command Button (change the Name property to cmdActions) and Label (change the Name property to lblMsg) . After you do this, just paste this code into the form you created.

'----------------------------------------------------------------------
'
'   Module Name:    frmTimedMsgBox
'   Written By:     C&D Programming Corp.
'   Create Date:    5/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Dim mlDelay As Long         ' number of seconds to wait for a response
Dim mlStartTime As Long     ' time when the message box was first shown

Public Sub ShowMessage(sMsg As String, lDelay As Long)
    lblMsg = sMsg       ' Show message text
    mlDelay = lDelay        ' Set delay amount variable
    mlStartTime = Timer     ' Get current timer
    tmrMsg.Interval = 1000  ' Make the timer interval 1 second
    tmrMsg.Enabled = True   ' Enable the timer
    Me.Show vbModal         ' Show the form modally
End Sub

Private Sub cmdActions_Click()
    Unload Me
End Sub

Private Sub tmrMsg_Timer()
    Dim lCurTime As Long

    lCurTime = Timer        ' Get current timer amount
    ' if we crossed midnight then just get out...
    ' we can change this calculation to be more specific
    ' around midnight, but we did not have a need to at
    ' this time.
    If lCurTime < mlStartTime Then
        Unload Me
    End If
    ' if our delay time has expired let's get out of here.
    If lCurTime - mlStartTime > mlDelay Then
        Unload Me
    End If
End Sub