带有MsgBox的HTA Timer在时间用完之前?

时间:2016-11-22 12:54:03

标签: vbscript timer hta

我用this script创建了一个本地倒数计时器。我已经通过按“重置”按钮修改了脚本以重新启动。

但我想知道是否有可能在计时器用完前5分钟显示一个MsgBox?但是计时器需要继续运行直到它超时,并显示最后一个MsgBox。

非常欢迎任何帮助或建议

<head>
<HTA:APPLICATION
  APPLICATIONNAME="Countdown Timer"
  BORDER="thin"
  MAXIMIZEBUTTON="no"
  MINIMIZEBUTTON="no"
  SCROLL="no"
  SINGLEINSTANCE="yes"
  CONTEXTMENU="no"
  SELECTION="no"/>
</head>

<title>Countdown Timer</title>

<SCRIPT language="VBScript">

    Dim pbTimerID
    Dim pbHTML 
    Dim pbWaitTime
    Dim pbHeight
    Dim pbWidth
    Dim pbBorder
    Dim pbUnloadedColor
    Dim pbLoadedColor
    Dim pbStartTime

    Sub Window_OnLoad
        window.resizeTo 500,250 ' Width,Height      
        ' Progress Bar Settings
        pbWaitTime = 1200       ' How many seconds the progress bar lasts
        pbHeight = 30       ' Progress bar height
        pbWidth= 450        ' Progress bar width
        pbUnloadedColor="white"     ' Color of unloaded area
        pbLoadedColor="grey"        ' Color of loaded area
        pbBorder="black"        ' Color of Progress bar border  
        ' Don't edit these things
        pbStartTime = Now
        rProgressbar
        pbTimerID = window.setInterval("rProgressbar", 200)

    End Sub


    Sub rProgressbar
        pbHTML = ""
        pbSecsPassed = DateDiff("s",pbStartTime,Now)
        pbMinsToGo =  Int((pbWaitTime - pbSecsPassed) / 60)
        pbSecsToGo = Int((pbWaitTime - pbSecsPassed) - (pbMinsToGo * 60))
        if pbSecsToGo < 10 then
            pbSecsToGo = "0" & pbSecsToGo 
        end if
        pbLoadedWidth = (pbSecsPassed / pbWaittime) * pbWidth
        pbUnloadedWidth = pbWidth - pbLoadedWidth
        pbHTML = pbHTML & "<table border=1 bordercolor=" & pbBorder & " cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
        pbHTML = pbHTML & "<th width=" & pbLoadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbLoadedColor & "></th>"
        pbHTML = pbHTML & "<th width=" & pbUnloadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbUnLoadedColor & "></th>"
        pbHTML = pbHTML & "</tr></table><br>"
        pbHTML = pbHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
        pbHTML = pbHTML & "<td align=center width=" & pbWidth & "% height=" & pbHeight & ">" & pbMinsToGo & ":" & pbSecsToGo & " remaining</td>"
        pbHTML = pbHTML & "</tr></table>"
        progressbar.InnerHTML = pbHTML

        if DateDiff("s",pbStartTime,Now) >= pbWaitTime then 
        StopTimer 
        DoAction
        End if
    End Sub

    Sub StopTimer
        window.clearInterval(PBTimerID)
    End Sub

    Sub DoAction
        MsgBox "The Final Countdown"
    End Sub

    Sub ResetTimer
        Call Window_OnLoad
    End Sub

    Sub CancelAction
        On Error Resume Next
        Self.Close
    End Sub
</SCRIPT>

<body>
<div align="center">
Game countdown 20min<br><br>
<span id="progressbar"></span>
<br>
<input type="Button" value="Reset" onClick="ResetTimer" class="button"> <input type="Button" value="Close" onClick="CancelAction" class="button">
</div>
</body>

2 个答案:

答案 0 :(得分:2)

您可以尝试使用此示例,而不是使用可以与span标记一起使用的MsgBox作为警告消息:

<head>
<HTA:APPLICATION
  APPLICATIONNAME="Countdown Timer"
  BORDER="thin"
  MAXIMIZEBUTTON="no"
  MINIMIZEBUTTON="no"
  SCROLL="no"
  SINGLEINSTANCE="yes"
  CONTEXTMENU="no"
  SELECTION="no"/>
</head>

<title>Countdown Timer</title>

<SCRIPT language="VBScript">

    Dim pbTimerID
    Dim pbHTML 
    Dim pbWaitTime
    Dim pbHeight
    Dim pbWidth
    Dim pbBorder
    Dim pbUnloadedColor
    Dim pbLoadedColor
    Dim pbStartTime

    Sub Window_OnLoad
        window.resizeTo 500,250 ' Width,Height      
        ' Progress Bar Settings
        pbWaitTime = 1200       ' How many seconds the progress bar lasts
        pbHeight = 30       ' Progress bar height
        pbWidth= 450        ' Progress bar width
        pbUnloadedColor="white"     ' Color of unloaded area
        pbLoadedColor="grey"        ' Color of loaded area
        pbBorder="black"        ' Color of Progress bar border  
        ' Don't edit these things
        pbStartTime = Now
        rProgressbar
        pbTimerID = window.setInterval("rProgressbar", 200)

    End Sub


    Sub rProgressbar
        pbHTML = ""
        pbSecsPassed = DateDiff("s",pbStartTime,Now)
        pbMinsToGo =  Int((pbWaitTime - pbSecsPassed) / 60)
        pbSecsToGo = Int((pbWaitTime - pbSecsPassed) - (pbMinsToGo * 60))
        if pbSecsToGo < 10 then
            pbSecsToGo = "0" & pbSecsToGo 
        end if
        pbLoadedWidth = (pbSecsPassed / pbWaittime) * pbWidth
        pbUnloadedWidth = pbWidth - pbLoadedWidth
        pbHTML = pbHTML & "<table border=1 bordercolor=" & pbBorder & " cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
        pbHTML = pbHTML & "<th width=" & pbLoadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbLoadedColor & "></th>"
        pbHTML = pbHTML & "<th width=" & pbUnloadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbUnLoadedColor & "></th>"
        pbHTML = pbHTML & "</tr></table><br>"
        pbHTML = pbHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
        pbHTML = pbHTML & "<td align=center width=" & pbWidth & "% height=" & pbHeight & ">" & pbMinsToGo & ":" & pbSecsToGo & " remaining</td>"
        pbHTML = pbHTML & "</tr></table>"
        progressbar.InnerHTML = pbHTML

        If DateDiff("s",pbStartTime,Now) = 5 Then
            Warning.InnerHTML = "<marquee  BEHAVIOR=""alternate"" BGCOLOR=""lime""><font face=""Comic sans MS"" color=""RED"" size=""3""><b>ATTENTION THIS IS A WARINING MESSAGE</b></font></marquee><br><br>"
        End If

        if DateDiff("s",pbStartTime,Now) >= pbWaitTime then 
        StopTimer 
        DoAction
        End if
    End Sub

    Sub StopTimer
        window.clearInterval(PBTimerID)
    End Sub

    Sub DoAction
        MsgBox "The Final Countdown"
    End Sub

    Sub ResetTimer
        Warning.InnerHTML=""
        Call Window_OnLoad
    End Sub

    Sub CancelAction
        On Error Resume Next
        Self.Close
    End Sub
</SCRIPT>

<body>
<div align="center">
Game countdown 20min<br><br>
<span id="progressbar"></span>
<span id="Warning"></span>
<input type="Button" value="Reset" onClick="ResetTimer" class="button"> <input type="Button" value="Close" onClick="CancelAction" class="button">
</div>
</body>

答案 1 :(得分:-1)

我通过替换这个单一的If语句来修复它:

if DateDiff("s",pbStartTime,Now) >= pbWaitTime then 
StopTimer 
DoAction
End if

分成两个单独的If语句:

    If DateDiff("s",pbStartTime,Now) = 900 Then
        AlmostTime
    End If

    If DateDiff("s",pbStartTime,Now) >= pbWaitTime Then
        StopTimer
        TimeUp
    End if

创建了一个名为AlmostTime的新Sub,它又显示了一个MsgBox或者我喜欢的任何内容。